* CHARS --- CHARACTER INSERT AND REMOVE FUNCTIONS * EHS 02/17/82 * * * CALLING INFORMATION * * CHAR = GET$XS (LINE, PTR) * CALL PUT$XS (LINE, PTR, CHAR) * * WHERE * * LINE IS AN ARRAY OF PACKED BYTES * PTR IS A BYTE (CHARACTER) POSITION IN THE LINE * (1 IS THE FIRST POSITION) * * THE CHARACTER RETURNED BY GET$XS IS IN THE LEAST SIGNIFICANT * BYTE OF CHAR (CHAR IS ASSUMED TO BE 1 WORD LONG) * THE CHARACTER SENT INTO PUT$XS IS ASSUMED TO BE IN THE LEAST * SIGNIFICANT BYTE OF CHAR * * BOTH ROUTINES NEED 4 WORDS OF TEMPORARY STORAGE AT THE USUAL * LOCATION IN THE STACK (SB% + '24) * * D64V REL POINTEMP EQU SB% + '24 RETURN EQU SB% + '26 LINE EQU XB% + 0 PTR EQU XB% + 3 CHAR EQU XB% + 6 ' get$xs --- get a byte from a line ENT GET$XS GET$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA PTR,* S1A ARS 1 TAX LDA LINE,*X SSC ICA CAL JMP RETURN,* ' put$xs --- put a byte into a packed line ENT PUT$XS PUT$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA PTR,* S1A ARS 1 TAX LDA CHAR,* CAL IMA LINE,*X SSC ICA CAR ORA LINE,*X SSC ICA STA LINE,*X JMP RETURN,* END * KEYS --- DO CPU KEYS MANIPULATION AS SHORTCALLS * EHS 02/17/82 * * * CALLING INFORMATION * * CALL GKY$XS (WORD) /* TO GET CURRENT KEYS * CALL SKY$XS (WORD) /* TO SET CURRENT KEYS * * WHERE * * WORD IS AN INTEGER TO CONTAIN KEYS * * BOTH SHORTCALL REQUIRES 2 WORDS OF TEMPORARY STACK SPACE * AT THE USUAL LOCATION (SB% + '24) * D64V REL POINTEMP EQU SB% + '24 ' gky$xs --- shortcall to get keys ENT GKY$XS GKY$XS EQU * STL POINTEMP TKA STA% POINTEMP,* JMP% XB% + 0 ' sky$xs --- shortcall to change keys ENT SKY$XS SKY$XS EQU * STL POINTEMP LDA% POINTEMP,* TAK JMP% XB% + 0 END * POKEPEEK --- PLAY WITH MEMORY DIRECTLY AS SHORTCALLS * EHS 02/17/82 * * * CALLING INFORMATION * * CALL POK$XS (ADDR, VALUE) * CALL PEK$XS (ADDR, VALUE) * * WHERE * * ADDR IS A TWO WORD VIRTUAL MEMORY ADDRESS * VALUE IS A ONE-WORD QUANTITY * * * BOTH ROUTINES NEED 4 WORDS OF TEMPORARY STACK SPACE AT THE * USUAL LOCATION (SB% + '24) * D64V REL POINTEMP EQU SB% + '24 RETURN EQU SB% + '26 ADDR EQU XB% + 0 VALUE EQU XB% + 3 ' pek$xs --- get a word from memory ENT PEK$XS PEK$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA% ADDR,* STA% VALUE,* JMP% RETURN,* ' pok$xs --- put a word into memory ENT POK$XS POK$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA% VALUE,* STA% ADDR,* JMP% RETURN END * QUEUE --- QUEUE OPERATIONS AS SHORTCALLS * EHS 02/17/82 * * * CALLING INFORMATION * * FLAG = ATQ$XS (QUEUCB, WORD) * FLAG = ABQ$XS (QUEUCB, WORD) * FLAG = RTQ$XS (QUEUCB, WORD) * FLAG = RBQ$XS (QUEUCB, WORD) * FLAG = TSQ$XS (QUEUCB, COUNT) * * WHERE * QUEUCB IS A QUEUE CONTROL BLOCK * WORD IS INTEGER*2 DATA WORD * FLAG GETS SET TO TRUE (1) FOR SUCCESS * (NON-EMPTY IN CASE OF TSQ$XS) * FLAG GETS RESET TO FALSE (0) FOR NO SUCCESS * (EMPTY IN CASE OF TSQ$XS) * * EACH OPERATION REQUIRES 4 TEMPORARY WORDS ON THE STACK * AT THE STANDARD LOCATION (SB% + '24) * D64V REL POINTEMP EQU SB% + '24 RETURN EQU SB% + '26 QUEUCB EQU XB% + 0 WORD EQU XB% + 3 ' atq$xs --- add to top of specified queue ENT ATQ$XS ATQ$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA WORD,* ATQ QUEUCB,* LCNE JMP% RETURN,* ' abq$xs --- add to bottom of specified queue ENT ABQ$XS ABQ$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA WORD,* ABQ QUEUCB,* LCNE JMP% RETURN,* ' rtq$xs --- remove from top of specified queue ENT RTQ$XS RTQ$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA WORD,* ATQ QUEUCB,* LCNE JMP% RETURN,* ' rbq$xs --- remove from bottom of specified queue ENT RBQ$XS RBQ$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA WORD,* ABQ QUEUCB,* LCNE JMP% RETURN,* ' tsq$xs --- test a queue for entries ENT TSQ$XS TSQ$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* TSTQ QUEUCB,* STA WORD,* LCNE JMP% RETURN,* END * STACK --- SET STACK EXTENSION POINTER AS A SHORTCALL * EHS 02/17/82 * * * CALLING INFORMATION * * CALL STK$XS (STACK, ADDR) * * WHERE * * STACK IS THE STACK ROOT SEGMENT * ADDR IS A 2 WORD ADDRESS OF THE LOCATION OF THE * STACK EXTENSION AREA * * IF STACK IS ZERO, THEN THE CURRENT STACK ROOT IS USED * IF STACK IS NEGATIVE, THEN THE CALL RETURNS THE * ADDRESS OF THE CURRENT EXTENSION IN "ADDR" * ('100000 IMPLIES CURRENT STACK) * * THE CALL USES 4 WORDS OF TEMPORARY STACK SPACE AT THE USUAL * LOCATION (SB% + '24) * * D64V REL POINTEMP EQU SB% + '24 RETURN EQU SB% + '26 STACK EQU XB% + 0 ADDR EQU XB% + 3 ' stk$xs --- set stack extension pointer as a shortcall ENT STK$XS STK$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA% STACK,* CAZ JMP% STORE SKP JMP% READ * * USE CURRENT STACK ROOT * LDA SB% + 1 * STORE EQU * CRB EAXB ADDR,* STL POINTEMP LDL% XB% + 0 STL% POINTEMP,* JMP% RETURN,* * * FETCH CURRENT EXTENSION POINTER * READ EQU * EAXB ADDR,* IAB CRA A2A IAB CHS BEQ READCUR CHS TCA JMP DOREAD READCUR EQU * LDA SB% + 1 DOREAD STL POINTEMP LDL% POINTEMP,* STL% XB% + 0 JMP% RETURN,* END * STOREC --- STORE A VARIABLE IN CONCURRENT ENVIRONMENT * EHS 02/17/82 * * * CALLING INFORMATION * * FLAG = S1C$XS (ADDR, IWORD, IOLDVL) /* STORE 1 WORD QUANTITY * FLAG = S2C$XS (ADDR, LWORD, LOLDVL) /* STORE 2 WORD QUANTITY * * WHERE * ADDR IS A TWO WORD VIRTUAL MEMORY ADDRESS * AS IN LOC(VARIABLE) * * IF THE VALUE IN THE VARIABLE AT THE TIME OF THE STORE IS * NOT THE SAME AS THE SUPPLIED OLD VALUE (OLDVAL), THEN * THE STORE IS NOT DONE AND THE FUNCTION RETURN IS FALSE. * IF THE STORE IS SUCCESSFUL, THE THE FUNCTION RETURN IS TRUE. * * EACH ROUTINE REQUIRES 4 WORDS OF TEMPORARY STACK SPACE * AT THE USUAL LOCATION (SB% + '24) * * D64V REL POINTEMP EQU SB% + '24 RETURN EQU SB% + '26 ADDR EQU XB% + 0 VALUE EQU XB% + 3 OLDVAL EQU XB% + 6 ' s1c$xs --- store single word variable ENT S1C$XS S1C$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA OLDVAL,* TAB LDA VALUE,* STAC ADDR,* LCEQ JMP% RETURN,* ' s2c$xs --- store double word variable ENT S2C$XS S2C$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDL OLDVAL,* ILE LDL VALUE,* STLC ADDR,* LCEQ JMP% RETURN,* END * READYC --- IF A CHARACTER IS WAITING, FETCH IT * EHS 02/27/82 * * CALLING INFORMATION: * * FLAG = RDY$XS (CHAR) * * WHERE * * FLAG IS A BOOLEAN VARIABLE SET TO ".TRUE." IF THERE WAS * A CHARACTER WAITING, ".FALSE." OTHERWISE * CHAR IS A CHARACTER VARIABLE WHICH GETS SET TO THE * CHARACTER WHICH WAS WAITING IF THE FUNCTION IS .TRUE. * * * THE FUNCTION REQUIRES FOUR WORDS OF TEMPORARY STORAGE ON THE * STACK AT THE USUAL LOCATIONS (SB% + '24 TO SB% + '27). * * SEG ' rdy$xs --- if a character is waiting, fetch it ENT RDY$XS RDY$XS EQU * STL SB% + '24 EAL XB% + 0 STL SB% + '26 E64R:D64R LT SKS '704 THE FAULT HANDLER TAKES CARE OF THIS CRA E64V:D64V BEQ DONE PCL IP_T1IN,* FETCH THE CHARACTER AP SB% + '24,*SL LT DONE EQU * JMP SB% + '26,* EXT T1IN IP_T1IN IP T1IN END * MAKE QUEUE --- MAKE A QUEUE IN GIVEN AREA, RETURN CONTROL BLOCK * EHS 02/27/82 * * CALLING INFORMATION * * SIZE = MKQ$XS (ADDR, ROOM, CONTROL) * * WHERE * * ADDR IS A TWO WORD POINTER IN MEMORY * ROOM IS THE AMOUNT OF FREE SPACE AVAILABLE * CONTROL IS THE RETURNED CONTROL BLOCK * * REQUIRES 4 WORDS OF TEMPORARY STORAGE ON THE STACK * AT THE USUAL LOCATION FOR SHORT CALLS (SB% + '24) * * SEG RLIT POINTEMP EQU SB% + '24 RETURN EQU SB% + '26 ROOM EQU SB% + '24 AREA EQU SB% + '25 CONTROL EQU XB% + 0 ' mkq$xs --- make a queue in given area, return control block ENT MKQ$XS MKQ$XS EQU * STL POINTEMP EAL XB% + 0 STL RETURN EAXB POINTEMP,* LDA XB% + 3,* STA ROOM LDL XB% + 0,* EAXB XB% + 6,* ANA ='7777 CHS STA CONTROL + 2 TBA STA AREA LDA ROOM LDX =0 ARL 4 BEQ BAD * LOOP EQU * ARL 1 BEQ SIZED BIX LOOP * SIZED EQU * LDA POWERS,X S1A STA CONTROL + 3 ADD AREA STA CONTROL LDA POWERS,X TCA ANA CONTROL STA CONTROL STA CONTROL + 1 SUB AREA ADD POWERS,X SUB ROOM BLE OKAY TXA BEQ BAD DRX RCB JMP SIZED * OKAY EQU * LDA CONTROL + 3 JMP% RETURN,* * BAD EQU * CRA JMP% RETURN,* * POWERS OCT 20,40,100,200,400,1000,2000,4000 OCT 10000,20000,40000,100000 END