PAGE * * modified for AP assembler - 3/26/25 - kdr * * * * G O R D O M A S T E R * * C O M M A N D L A N G U A G E P R O C E S S O R * * * * AUTHOR -- KELLY BOOTH (JUNE 1, 1969) * * MODIFIED -- KELLY BOOTH (APRIL 5, 1972) * * MODIFIED -- C. S. WETHERELL (JUNE 30, 1972) * CONVERT XPL SUBMONITOR SO THAT XPL IS COMPLETELY IN * ASCII, RATHER THAN PARTIALLY IN EBCDIC. * * MODIFIED -- J. BOLSTAD (9-7-72) * ADDED FEATURES TO XPL SUBMONITOR: * (1) OPTION TO AVOID ENTERING COMPILER SCRATCH FILES * IN ROOT DIRECTORY * (2) OUTPUT ALL OF XPL LINE TO THE SCREEN, NOT JUST * FIRST 79 CHARACTERS * (3) THE SEARCH FOR CONTROL CHARACTERS IN XPL WRITE * TEXT IS MUCH FASTER. * * * * PAGE * * REGISTER EQUIVALENCES * R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 * PAGE * * * * ************************************* * * * * * GORDO SYSTEM CALL TRANSFER VECTOR * * * * * ************************************* * * * G:SYSRTN EQU $+X'1E000' G:COUPLE EQU $+X'1E001' G:CREATE EQU $+X'1E002' G:ENTER EQU $+X'1E003' G:OPEN EQU $+X'1E004' G:CLOSE EQU $+X'1E005' G:FORK EQU $+X'1E006' G:PRINT EQU $+X'1E007' G:READ EQU $+X'1E008' G:SETABR EQU $+X'1E009' G:GIVEUP EQU $+X'1E00A' G:WAKEUP EQU $+X'1E00B' G:SLEEP EQU $+X'1E00C' G:ATTACH EQU $+X'1E00D' G:DETACH EQU $+X'1E00E' G:TIME EQU $+X'1E00F' G:INSERT EQU $+X'1E010' G:DELETE EQU $+X'1E011' G:MODIFY EQU $+X'1E012' G:STATUS EQU $+X'1E013' G:MOVEIO EQU $+X'1E014' G:LOCK EQU $+X'1E015' G:UNLOCK EQU $+X'1E016' G:REALAD EQU $+X'1E017' G:FORKJ EQU $+X'1E018' G:CRJOB EQU $+X'1E019' G:DLJOB EQU $+X'1E01A' G:KLPRC EQU $+X'1E01B' G:KLJOB EQU $+X'1E01C' G:INTPRC EQU $+X'1E01D' G:STPPRC EQU $+X'1E01E' G:READQ EQU $+X'1E01F' G:SETQ EQU $+X'1E020' G:CHGENT EQU $+X'1E021' G:LPEN EQU $+X'1E022' G:EDGE EQU $+X'1E023' G:MRKDWN EQU $+X'1E024' G:SYSTRP EQU $+X'1E025' G:SETINT EQU $+X'1E026' G:SVC EQU $+X'1E027' G:RESET EQU $+X'1E028' G:STRPRC EQU $+X'1E029' G:SETPSD EQU $+X'1E02A' G:ASSIGN EQU $+X'1E02B' G:ASSINP EQU $+X'1E02C' G:FINPRC EQU $+X'1E02D' G:CLOCK EQU $+X'1E033' G:PMT EQU $+X'1E200' G:MSGCNT EQU $+X'1E319' G:MSGBFR EQU $+X'1E31A' G:INTPSW EQU $+X'1E313' G:ABRNUM EQU $+X'1E315' G:ABRPSW EQU $+X'1E316' G:PRCNUM EQU $+X'1E34C' G:JOBNUM EQU $+X'1E34E' G:SECURE EQU $+X'1E350' G:ASLIFE EQU $+X'1E351' * PAGE * * * COUPLE COM,8,8,16 AF(1),AF(2),AF(3) CREATE COM,2,2,1,3,4,4,16 AF(1),0,AF(2),AF(3),AF(4),AF(5),AF(6) OPEN_ COM,4,4,1,6,17,2,30 AF(1),AF(2),AF(3),0,AF(4),AF(5),0 STKPTR COM,1,15,1,15 AF(1),AF(2),AF(3),AF(4) * KYWPRG EQU 1 RUNNING PROGRAM KYWLIB EQU 2 FORTRAN LIBRARY KYWUTL EQU 3 KYWSCR EQU 10 KYWCLP EQU 11 KYWRTD EQU 12 KYWCMP EQU 14 * KBL EQU X'40' X'00' BLANK KPS EQU X'7B' X'03' POUND SIGN KCM EQU X'6B' X'0C' COMMA KPER EQU X'4B' X'0E' PERIOD KSC EQU X'5E' X'1B' SEMI-COLON KLB EQU X'BA' X'1C' LEFT BRACKET KEQ EQU X'7E' X'1D' EQUAL SIGN KLA EQU X'4C' X'3F' LEFT ARROW KCR EQU X'0D' X'8F' CARRIAGE RETURN KEX EQU X'27' X'A8' ESCAPE CHARACTER * HDRPAGE EQU 0 PAGE NUMBER FOR FILE HEADER * PAGE * * * * ******************** * * * * * BOOTSTRAP LOADER * * * * * ******************** * * * ORG X'200' * BTSKYM GEN,8,24 X'0F',0 BTSKYW GEN,8,24 KYWCLP,0 BTSOPM OPEN_ KYWRTD,KYWCLP,0,$+1,1 TEXT ' MASTER ' BTSOPP OPEN_ KYWRTD,KYWCLP,0,$+1,2 TEXT ' PUBLIC ' BTSOPX OPEN_ KYWCLP,KYWCLP,0,$+1,1 TEXT ' MASTER ' * BTSBGN RES 0 LI,R1 $ SAS,R1 -9 LW,R0 G:PMT,R1 AND,R0 BTSKYM CW,R0 BTSKYW BE BTSLDR * LW,R13 BTSOPM BAL,R14 G:OPEN TRY TO OPEN 'MASTER' FROM 'ROOT' BEZ BTSLDR ALL SET IF FOUND LW,R13 BTSOPP BAL,R14 G:OPEN OTHERWISE OPEN PUBLIC BNEZ G:FINPRC LW,R13 BTSOPX BAL,R14 G:OPEN THEN TRY AGAIN BNEZ G:FINPRC * BTSLDR RES 0 LI,R1 6 +++ VERY IMPORTANT +++ LI,R0 WRKLWA SAS,R0 -9 STH,R0 R1 LI,R0 KYWCLP STB,R0 R1 LI,R0 WRKFWA AI,R0 -X'1E000' SAS,R0 -9 * BTSCPL RES 0 LW,R13 R1 BAL,R14 G:COUPLE AI,R1 X'10001' BIR,R0 BTSCPL * B NLZMST * PAGE * * XPL WORKING AREA * * XPLSTK EQU X'1CE00' XPL STACK PAGE XPLBIN EQU X'1A000' XPL BINARY PAGE XPLMAP EQU X'1A000' XPL TEXT MAP PAGE XPLDATA EQU X'1B200' XPL TEXT DATA PAGE * PAGE * * * * ***************** * * * * * WORKING PAGES * * * * * ***************** * * * ORG X'400' LOC X'1D000' * SCRLD1 EQU $$ SCRPG1 RES 0 * SCRLD2 EQU $$ SCRPG2 RES 512 * WRKLDA EQU $$ WRKFWA RES 0 * PAGE * * * * ******************************* * * * * * EXECUTABLE FILE HEADER PAGE * * * * * ******************************* * * * ORG SCRLD2 LOC SCRPG2 * XFLHDR DATA X'F0F0F0F0' XFLFFP DATA 0 XFLFVP DATA 0 XFLNVP DATA 0 XFLXSL DATA 0 * PAGE * * * * ****************** * * * * * DIRECTORY PAGE * * * * * ****************** * * * ORG SCRLD2 LOC SCRPG2 * DRCHDR RES 0 * PAGE * * * * *************************** * * * * * PROCESS DESCRIPTOR PAGE * * * * * *************************** * * * ORG SCRLD2 LOC SCRPG2 * PDPPAG RES 0 * PAGE * * * * ************************** * * * * * SCRATCH FILE WORK AREA * * * * * ************************** * * * ORG WRKLDA LOC WRKFWA * IDLNLZ DATA 0 * XPLMSG DATA 0 SAVE FOR SUB-MONITOR ERROR MESSAGE XPLREG RES 16 XPL SUB-MONITOR REGISTER SAVE AREA * * FILE CONTROL BLOCKS FOR XPL SUBMONITOR * NFCB EQU 10 NUMBER OF LOGICAL UNITS ALLOWED * FCBUNIT RES NFCB LOGICAL UNIT NUMBER FCBTYPE RES NFCB UNIT STATUS FLAGS FCBMAP RES NFCB ADDRESS OF MAP PAGE FCBDATA RES NFCB ADDRESS OF DATA PAGE FCBLINE RES NFCB CURRENT LINE NUMBER FCBNEXT RES NFCB INDEX TO NEXT LINE FCBPAGE RES NFCB CURRENT DATA PAGE NUMBER FCBOPN OPEN_ 0,0,0,$+1,0 TEXT ' XPL-FILE ' * FCB:USED EQU X'80' UNIT ASSIGNED FCB:ROOT EQU X'40' DO NOT ENTER IN ROOT DIRECTORY FCB:NEW EQU X'20' CREATE NEW FILE FCB:FRMT EQU X'10' FORMAT CONTROL FCB:OUT EQU X'08' OUTPUT FCB:IN EQU X'04' INPUT FCB:TEXT EQU X'02' TEXT FILE FCB:FILE EQU X'01' FILE/CONSOLE (1 IF CONSOLE) * USRSWT DATA 0 USER SWITCH USRPSW DATA 0 USER'S PROGRAM STATUS WORD USRINS DATA 0 USRREG RES 16 USER'S REGISTERS USRMCT DATA 0 USER'S MESSAGE BUFFER COUNT USRMBF RES,1 128 USER'S MESSAGE BUFFER * NLZSWT DATA 0 MASTER/FORK SWITCH * TRPSWT DATA 0 ABORT/INTERRUPT SWITCH * BRKNUM DATA 0 NUMBER OF BREAK POINT BRKLOC RES 16 LOCATIONS OF BREAK POINTS BRKVAL RES 16 CONTENTS OF BREAK POINTS * CMDSWT DATA 0 CMDMNT DATA 0 MONITOR MODE SWITCH * WRTSWT DATA 0 BLANK SWITCH FOR OUTPUT WRTPTR DATA 0 OUTPUT BUFFER POINTER WRTBFR RES,1 80 OUTPUT BUFFER * ESCSWTCH RES 1 ESCAPE CHARACTER FLAG TKNSWT DATA 0 TKNBFR RES,1 8 * SCNWRK RES 3 SCNCMS DATA 0 SCANNER COMMA SWITCH SCNPTR DATA 0 POINTER TO CHAR. IN SCANNER BUFFER SCNEOL DATA 0 SCNCNT DATA 0 SCNXSC DATA 0 ESCAPE CHARACTER SWITCH SCNSWT DATA 0 SCNBFR RES,1 80 BUFFER FOR SCANNER * FNMCNT DATA 0 FNMSWT DATA 0 FILE NAME SWITCH FNMBFR RES,1 12 FILE NAME BUFFER FNMBLK DATA 0 BLANK FILE NAME SWITCH * EXPBLK DATA 0 BLANK EXPRESSION SWITCH EXPSWT DATA 0 EXPRESSION SWITCH * MNPPRC DATA 0 MNPCAL DATA $+1,0 TEXT ' FILENAME ' * FRTSWT DATA 0 FRTABR DATA 0,0 * SHWBFR TEXTC 'FILENAME ' SHWKYW DATA 0 SHWCNT DATA 0 SHWSWT DATA 0 SHWOPD DATA X'C0000000' TEXT ' FILENAME ' * OPNLDR DATA 0 OPNDEL DATA 0 OPNACC DATA 0 ACCESS OF FILE OPNKYW DATA 0 KEYWORD FOR FILE OPNDIR DATA 0 KEYWORD FOR FILE OPNSWT DATA 0 OPEN SWITCH OPNARG OPEN_ 0,0,0,$+1,0 TEXT ' FILE NAME' * BOUND 8 SYSVAL DATA SYSREG-1 DATA,2 10,0 SYSREG RES 10 SYSBAL DATA 0 * SVCSWT DATA 0 * XECSWT DATA 0 GO/PROCEED SWITCH * LDRSWT DATA 0 EXECUTE/LOAD SWITCH * MSGSWT DATA 0 EXIT WITH COMMAND SWITCH * BOUND 8 WRKSTK DATA WRKSTK+1 STKPTR 1,WRKSIZ,1,0 * BOUND 2048 * WRKLWA RES 0 * WRKSIZ EQU WRKLWA-WRKSTK-2 * PAGE * * * * ******************* * * * * * OUTPUT MESSAGES * * * * * ******************* * * * * HENCEFORTH ALL LOCATIONS ARE AT * READ-ONLY ACCESS. * MSGINT TEXTC 'INTERRUPT' MSGERR TEXTC 'ERROR' MSGABR TEXTC 'ABORT' MSGBRK TEXTC 'BREAK' MSGCMD TEXTC 'UNRECOGNIZED COMMAND' MSGEXP TEXTC 'INVALID EXPRESSION' MSGFNM TEXTC 'INVALID FILE NAME' MSGIBP TEXTC 'INVALID BREAKPOINT' MSGBRZ TEXTC 'NOT SET' MSGSHW TEXTC 'CANNOT DELETE FILE' MSGOPN TEXTC 'CANNOT OPEN NAMED FILE' MSGPSD TEXTC 'PSD =' MSGLD1 TEXTC 'FILE IS NOT EXECUTABLE' MSGLD2 TEXTC 'COUPLE ERROR LOADING' MSGLD3 TEXTC 'LIBRARY IS NOT EXECUTABLE' MSGLD4 TEXTC 'COUPLE ERROR LOADING LIBRARY' MSGPRC TEXTC 'PROCESS' MSGFLR TEXTC 'CANNOT OPEN DIRECTORY' MSGFRR TEXTC 'ERROR IN FORK' MSGMNP TEXTC 'CANNOT MAKE ENTRY IN DIRECTORY' MSGARG TEXTC 'TOO MANY ARGUMENTS' MSGKIL TEXTC 'HAS BEEN KILLED' MSGREQ TEXTC 'REQUESTS SERVICE' MSGPBR TEXTC 'HAS BEEN BROKEN' MSGSYS TEXTC 'VALUE =' MSGFRK TEXTC 'HAS BEEN FORKED' MSGEXT TEXTC 'END OF EXECUTION' MSGBGN TEXTC 'BEGIN EXECUTION' MSGIDL TEXTC 'MASTER PROCESS IN CONTROL' MSGLIB TEXTC 'CANNOT OPEN FORTRAN LIBRARY' MSGXP1 TEXTC 'ILLEGAL XPL SUBMONITOR CALL' MSGXP2 TEXTC 'NORMAL EXIT FROM XPL' MSGXP3 TEXTC 'ERROR EXIT FROM XPL' MSGXP4 TEXTC 'ERROR IN XPL BINARY READ/WRITE' MSGXP5 TEXTC 'ERROR IN XPL TEXT READ' MSGXP6 TEXTC 'ERROR IN XPL TEXT WRITE' MSGXP7 TEXTC 'ILLEGAL XPL I/O UNIT' MSGXP8 TEXTC 'DIAGNOSTIC VALUE =' MSGXP9 TEXTC 'SOURCE LINE NUMBER =' MSGXP10 TEXTC 'BEGIN XPL TRACE MODE (UNIMPLEMENTED)' MSGXP11 TEXTC 'TERMINATE XPL TRACE MODE' MSGXP12 TEXTC 'FILE' MSGXP13 TEXTC 'ASSIGNED TO UNIT' MSGXP14 TEXTC ', FILE TYPE' MSGXP15 TEXTC 'FILE XPL-INPUT IS MISSING' MSGXP16 TEXTC 'FILE XPL-SIGLIB IS MISSING' * PAGE * * * * * * * ******************* * * * * * READ-ONLY DATA * * * * * ******************* * * * * * THIS TABLE IS USED FOR ESCAPE CHARACTERS. * TTBSTABL DATA X'00000000',X'00000000',X'00000000',X'00000000' 0 - F DATA X'00000000',X'00000000',X'00000000',X'00000000' 10 - 1F DATA X'00000000',X'00000000',X'00000000',X'00000000' 20 - 2F DATA X'00000000',X'00000000',X'00000000',X'00000000' 30 - 3F DATA X'00000000',X'00000000',X'00000000',X'00000000' 40 - 4F DATA X'00000000',X'00000000',X'00000000',X'00000000' 50 - 5F DATA X'00000000',X'00000000',X'00000000',X'00000000' 60 - 6F DATA X'00000000',X'00000000',X'00000000',X'00000000' 70 - 7F DATA X'00000000',X'00000000',X'00000000',X'00000001' 80 - 8F DATA X'00000000',X'00000000',X'00000000',X'00000000' 90 - 9F DATA X'00000000',X'00000000',X'01000000',X'00000000' A0 - AF DATA X'00000000',X'00000000',X'00000000',X'00000000' B0 - BF DATA X'00000000',X'00000000',X'00000000',X'00000000' C0 - CF DATA X'00000000',X'00000000',X'00000000',X'00000000' D0 - DF DATA X'00000000',X'00000000',X'00000000',X'00000000' E0 - EF DATA X'00000000',X'00000000',X'00000000',X'01010101' F0 - FF * PAGE * * * * * ****************** * * * * * INITIALIZATION * * * * * ****************** * * * NLZCSF CREATE 0,0,0,0,KYWSCR,999 * * ENTRY POINT FOR MASTER PROCESS: * NLZMST RES 0 LI,R12 1 (12) <== 1 FOR MASTER B NLZBGN * * ENTRY POINT FOR FORKED PROCESS: * NLZFRK RES 0 LI,R12 0 (12) <== 0 FOR SLAVE NLZBGN RES 0 LW,R13 NLZCSF BAL,R14 G:CREATE CREATE A SCRATCH FILE BNEZ $ LI,R2 WRKFWA-WRKLWA SAS,R2 -9 NUMBER OF PAGES TO COUPLE LW,R1 R2 AI,R1 1000 STARTING FILE PAGE FOR COUPLE LI,R0 WRKFWA SAS,R0 -9 STH,R0 R1 VIRTUAL PAGE NUMBER LI,R0 KYWSCR STB,R0 R1 KEYWORD * NLZCPL RES 0 LW,R13 R1 AI,R1 X'10001' BAL,R14 G:COUPLE COUPLE IN WORK PAGES BNEZ $ BIR,R2 NLZCPL * STW,R12 NLZSWT SET MASTER/FORK SWITCH IN WORK AREA LI,R0 -1 STW,R0 IDLNLZ STW,R0 FRTSWT LI,R1 -16 * NLZBRK RES 0 STW,R0 BRKLOC+16,R1 BIR,R1 NLZBRK * B IDLPRG * PAGE * * * * **************** * * * * * IDLE PROGRAM * * * * * **************** * * * BOUND 8 IDLSTK DATA WRKSTK+1 STKPTR 1,WRKSIZ,1,0 * IDLPRG RES 0 LI,R0 0 STW,R0 TRPSWT STW,R0 USRSWT LI,R13 TRPABR BAL,R14 G:SETABR SET ABORT LOCATION LI,R13 TRPINT BAL,R14 G:SETINT SET INTERRUPT LOCATION LD,R0 IDLSTK STD,R0 WRKSTK INITIALIZE WORK STACK BAL,R15 WRTRST RESET OUTPUT BUFFER POINTER MTW,0 NLZSWT MASTER/FORK SWITCH BLEZ IDLCHK MTW,1 IDLNLZ BNEZ IDLCHK LI,R1 BA(MSGIDL) BAL,R15 WRTSEG BAL,R15 WRTOUT * * IDLE LOOP LOOKING FOR WORK: * IDLCHK RES 0 BAL,R15 CMDSCN DECODE INPUT FOR COMMAND BNEZ IDLCHK BAL,R15 SVCSCN CHECK FOR MASTER SERVICE CALLS BNEZ IDLCHK BAL,R14 G:SLEEP NO WORK. GO TO SLEEP. B IDLCHK * PAGE * * * * ***************** * * * * * INPUT SCANNER * * * * * ***************** * * * BOUND 8 SCNMV1 DATA BA(G:MSGBFR) GEN,8,24 80,BA(SCNBFR) * SCNINP RES 0 LI,R0 0 STW,R0 SCNSWT STW,R0 SCNXSC STW,R0 SCNEOL MTW,0 NLZSWT MASTER/FORK SWITCH BEZ SCNMVI MTW,0 MSGSWT BNEZ SCNMBS IF MESSAGE ALREADY WAITING, GO AHEAD BAL,R14 G:READ CHECK FOR INPUT LINE BLZ SCNXIT * SCNMVI RES 0 LCI 2 PSM,R2 WRKSTK LW,R0 G:MSGCNT STW,R0 SCNCNT LD,R2 SCNMV1 MBS,R2 0 GET MESSAGE FROM BUFFER * SCNMBS RES 0 LI,R0 0 STW,R0 MSGSWT RESET EXIT WITH COMMAND SWITCH LI,R0 BA(SCNBFR)-1 STW,R0 SCNPTR INITIALIZE SCANNER BUFFER POINTER MTW,0 NLZSWT MASTER/FORK SWITCH BEZ SCNBMP LI,R13 BA(SCNBFR) LW,R0 SCNCNT STB,R0 R13 BAL,R14 G:PRINT * SCNECH RES 0 MTW,1 SCNSWT LCI 2 PLM,R2 WRKSTK * SCNXIT RES 0 LW,R0 SCNSWT B *R15 * SCNBMP RES 0 MTW,-1 NLZSWT MASTER/FORK SWITCH B SCNECH * SCNXCH RES 0 MTW,1 SCNXSC INCREMENT ESCAPE CHAR. SWITCH * SCNCHR RES 0 SCAN CHARACTER XW,R2 SCNPTR MTW,1 R2 INCREMENT POINTER INTO SCAN BUFFER LB,R0 0,R2 GET CHARACTER * SCNSCK RES 0 MTW,0 SCNXSC ESCAPE CHAR. SWITCH BNEZ SCNCHK CI,R0 KSC SEMICOLON BNE SCNCHK LI,R0 KCR CARRIAGE RETURN * SCNCHK RES 0 LI,R1 0 STW,R1 SCNXSC RESET ESCAPE CHARACTER SWITCH LW,R1 R0 CI,R0 KCR CARRIAGE RETURN BNE SCNRET MTW,-1 R2 BACK UP POINTER MTW,-1 SCNEOL SET END-OF-LINE SWITCH * SCNRET RES 0 XW,R2 SCNPTR MTW,0 SCNEOL SET RETURN CODE B *R15 RETURN TO CALLER * SCNFNB RES 0 XW,R2 SCNPTR SCNBLS RES 0 SCAN BLANKS MTW,1 R2 LB,R0 0,R2 CI,R0 KBL BLANK BE SCNBLS B SCNSCK * SCNSKP RES 0 XW,R2 SCNPTR MTW,0 SCNEOL CHECK FOR END OF LINE BGZ SCNSKX LB,R0 0,R2 CI,R0 KCM COMMA BNE SCNSKB CHECK FOR A COMMA LI,R0 1 STW,R0 SCNCMS SET COMMA SWITCH MTW,1 R2 BUMP POINTER B SCNSKX * SCNSKB RES 0 CI,R0 KBL BNE SCNSKX CHECK FOR BLANK XW,R2 SCNPTR PSW,R15 WRKSTK BAL,R15 SCNFNB PLW,R15 WRKSTK CI,R0 KCM COMMA BE SCNSKP CI,R0 KCR CARRIAGE RETURN BE SCNSKX XW,R2 SCNPTR MTW,-1 R2 * SCNSKX RES 0 XW,R2 SCNPTR B *R15 * SCNSAV RES 0 PSW,R2 WRKSTK LCI 3 LM,R0 SCNCMS LCI 3 STM,R0 SCNWRK PLW,R2 WRKSTK B *R15 * SCNRST RES 0 PSW,R2 WRKSTK LCI 3 LM,R0 SCNWRK LCI 3 STM,R0 SCNCMS PLW,R2 WRKSTK B *R15 * PAGE * * * * ******************* * * * * * COMMAND SCANNER * * * * * ******************* * * * BOUND 8 CMDTBS RES 0 TEXT 'BREAK ' TEXT 'CALL ' TEXT 'CLEAR ' TEXT 'DELETE ' TEXT 'DESTROY ' TEXT 'EXECUTE ' TEXT 'EXIT ' TEXT 'ENTER ' TEXT 'FETCH ' TEXT 'FILES ' TEXT 'GO ' TEXT 'GIVE ' TEXT 'INSPECT ' TEXT 'LIST ' TEXT 'LOADX ' TEXT 'PROCEED ' TEXT 'PSD ' TEXT 'PUNCH ' TEXT 'PUNCHL ' TEXT 'PRINT ' TEXT 'REPLACE ' TEXT 'STEP ' TEXT 'VALUE ' TEXT 'X ' TEXT 'XPL ' TEXT 'ZAP ' CMDTBL DATA DA(CMDTBS)-DA(CMDTBL) * DATA BREAK DATA CALL DATA CLEAR DATA DELETE DATA DESTROY DATA EXECUTE DATA EXIT DATA ENTER DATA FETCH DATA FILES DATA GO DATA GIVE DATA INSPECT DATA LIST DATA LOAD DATA PROCEED DATA PSD DATA PUNCH DATA PUNCHL DATA PRINT DATA REPLACE DATA STEP DATA VALUE DATA EXIT DATA EXECUTE DATA ZAP CMDPRC RES 0 * CMDSCN RES 0 LI,R0 0 STW,R0 CMDSWT PSW,R15 WRKSTK BAL,R15 SCNINP BEZ CMDXIT BAL,R15 SCNSAV BAL,R15 SCNFNB BLZ CMDXIT BAL,R15 SCNRST LI,R0 CMDTBL BAL,R15 TKNEVL BEZ CMDERR LW,R0 CMDPRC,R1 LI,R15 0 STW,R15 OPNLDR STW,R15 SCNCMS BAL,R15 *R0 BAL,R15 WRTRST RESET OUTPUT ROUTINES MTW,1 CMDSWT * CMDXIT RES 0 PLW,R15 WRKSTK LW,R0 CMDSWT B *R15 * CMDERR RES 0 LI,R1 BA(MSGCMD) B ERRXIT * PAGE * * * * ***************** * * * * * ERROR HANDLER * * * * * ***************** * * * ERRXIT RES 0 BAL,R15 WRTRST BAL,R15 WRTSEG BAL,R15 WRTOUT B IDLPRG * PAGE * * * * ******************* * * * * * TOKEN EVALUATOR * * * * * ******************* * * * TKNEVL RES 0 PSW,R15 WRKSTK LCI 4 PSM,R2 WRKSTK SAVE REGISTERS LW,R4 R0 LW,R3 *R4 SAS,R4 -1 AW,R4 R3 SAS,R4 3 LI,R0 0 STW,R0 TKNSWT LI,R2 0 BAL,R15 SCNFNB BLZ TKNXIT * TKNCOL RES 0 STB,R0 TKNBFR,R2 CI,R2 9 BE TKNXIT MTW,1 R2 BAL,R15 SCNCHR BLZ TKNFND CI,R0 KCM BE TKNFND CI,R0 KBL BNE TKNCOL * TKNFND RES 0 LI,R5 BA(TKNBFR) STB,R2 R5 MTW,1 TKNSWT LW,R1 R3 * TKNSCN RES 0 LD,R2 R4 AI,R4 8 BUMP POINTER CBS,R2 0 BE TKNXIT SEE IF TOKEN IS IN TABLE BIR,R1 TKNSCN MTW,-1 TKNSWT TOKEN NOT FOUND * TKNXIT RES 0 LCI 4 PLM,R2 WRKSTK RESTORE REGISTERS PLW,R15 WRKSTK LW,R0 TKNSWT B *R15 * PAGE * * * * *********************** * * * * * FILE NAME EVALUATOR * * * * * *********************** * * * FNMCLR GEN,8,24 10,BA(FNMBFR) FNMNLZ DATA,5 ' ' * FNMEVL RES 0 LW,R1 FNMCLR MBS,R0 FNMNLZ LI,R0 0 STW,R0 FNMBLK STW,R0 FNMSWT PSW,R15 WRKSTK PSW,R2 WRKSTK LI,R2 0 BAL,R15 SCNFNB BLZ FNMNUL CI,R0 KCM BE FNMNUL CI,R0 KBL BE FNMNUL * FNMSCN RES 0 CI,R0 KPER CHECK FOR CONCATENATION BE FNMDOT CI,R2 10 CHECK FOR FILE NAME TOO LARGE BE FNMERR CI,R0 KEX BNE FNMSTF BAL,R15 SCNXCH BLZ FNMERR * FNMSTF RES 0 STB,R0 FNMBFR,R2 MTW,1 R2 BAL,R15 SCNCHR GET NEXT CHARACTER BLZ FNMOUT CI,R0 KCM BE FNMOUT CI,R0 KBL BE FNMOUT B FNMSCN * FNMERR RES 0 LI,R1 BA(MSGFNM) B ERRXIT * FNMNUL RES 0 MTW,1 FNMBLK FNMOUT RES 0 MTW,1 FNMSWT FNMDOT RES 0 STW,R2 FNMCNT * FNMXIT RES 0 PLW,R2 WRKSTK PLW,R15 WRKSTK LW,R0 FNMSWT B *R15 * PAGE * * * * ************************ * * * * * EXPRESSION EVALUATOR * * * * * ************************ * * * EXPMSK DATA X'F' BOUND 8 EXPDEC DATA '0','9' EXPHEX DATA 'A','F' * EXPEVL RES 0 PSW,R15 WRKSTK PSW,R2 WRKSTK LI,R2 0 STW,R2 EXPSWT BAL,R15 SCNFNB BLZ EXPNUL CI,R0 KCM BE EXPNUL * EXPSCN RES 0 CLM,R0 EXPDEC IS IT DECIMAL BCR,9 EXPDGT CLM,R0 EXPHEX IS IT HEX BCS,9 EXPERR AI,R0 9 * EXPDGT RES 0 AND,R0 EXPMSK SAS,R2 4 AW,R2 R0 BAL,R15 SCNCHR BLZ EXPOUT CI,R0 KBL BE EXPOUT CI,R0 KCM BNE EXPSCN * EXPOUT RES 0 MTW,1 EXPSWT LW,R1 R2 PLW,R2 WRKSTK PLW,R15 WRKSTK LW,R0 EXPSWT B *R15 * EXPNUL RES 0 MTW,1 EXPBLK B EXPOUT * EXPERR RES 0 LI,R1 BA(MSGEXP) B ERRXIT * PAGE * * * * ***************** * * * * * SHOW AND TELL * * * * * ***************** * * * SHWOPA OPEN_ KYWUTL,0,1,SHWOPD,3 SHWMBS GEN,8,24 10,BA(SHWBFR)+1 SHWPBN TEXT 'PUBLIC ' SHWCMN TEXT 'USERCOMPF ' SHWMBD GEN,8,24 10,BA(SHWOPD)+6 BOUND 8 SHWMSG DATA BA(SHWOPD)+6 GEN,8,24 10,BA(SHWBFR)+1 SHWPUB DATA BA(SHWOPD)+6 GEN,8,24 10,BA(SHWPBN) SHWCMP DATA BA(SHWOPD)+6 GEN,8,24 10,BA(SHWCMN) * INSPECT RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK * SHWINL RES 0 MTW,0 SCNEOL BNEZ SHWXIT BAL,R15 EXPEVL LW,R3 R1 LW,R0 R1 LI,R1 5 BAL,R15 WRTHEX LI,R0 KEQ LI,R1 0 BAL,R15 WRTCHR BAL,R15 USRGET LW,R0 R2 LI,R1 8 BAL,R15 WRTHEX BAL,R15 WRTOUT B SHWINL * SHWXIT RES 0 LCI 2 PLM,R2 WRKSTK PLW,R15 WRKSTK B *R15 * REPLACE RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK MTW,0 SCNEOL BNEZ SHWXIT BAL,R15 EXPEVL LW,R3 R1 * SHWRPL RES 0 MTW,0 SCNEOL BNEZ SHWXIT BAL,R15 EXPEVL LW,R2 R1 BAL,R15 USRPUT LW,R0 R3 LI,R1 5 BAL,R15 WRTHEX LI,R0 KLA BAL,R15 WRTCHR LW,R0 R2 LI,R1 8 BAL,R15 WRTHEX BAL,R15 WRTOUT MTW,1 R3 B SHWRPL * LIST RES 0 PSW,R15 WRKSTK LCI 4 PSM,R2 WRKSTK MTW,0 SCNEOL BNEZ SHWLXT BAL,R15 EXPEVL LW,R3 R1 MTW,0 SCNEOL BNEZ $+2 BAL,R15 EXPEVL LW,R4 R1 * SHWLST RES 0 LI,R5 -8 LW,R0 R3 LI,R1 5 BAL,R15 WRTHEX * SHWLSL RES 0 BAL,R15 USRGET LW,R0 R2 LI,R1 8 BAL,R15 WRTHEX CW,R3 R4 BE SHWOUT MTW,1 R3 BIR,R5 SHWLSL BAL,R15 WRTOUT B SHWLST * SHWOUT RES 0 BAL,R15 WRTOUT * SHWLXT RES 0 LCI 4 PLM,R2 WRKSTK PLW,R15 WRKSTK LI,R13 KYWUTL BAL,R14 G:CLOSE CLOSE OUT KEYWORD FOR DESTROY B *R15 * SHWOUF RES 0 MTW,0 SHWSWT BLEZ SHWLXT B SHWOUT * VALUE RES 0 PSW,R15 WRKSTK * SHWVLP RES 0 MTW,0 SCNEOL BNEZ SHWVXT BAL,R15 EXPEVL LW,R0 R1 LI,R1 8 BAL,R15 WRTHEX BAL,R15 WRTOUT B SHWVLP * SHWVXT RES 0 PLW,R15 WRKSTK B *R15 * PSD RES 0 PSW,R15 WRKSTK MTW,0 SCNEOL BNEZ SHWPSD BAL,R15 EXPEVL STW,R1 USRPSW * SHWPSD RES 0 LI,R1 BA(MSGPSD) BAL,R15 WRTSEG LW,R0 USRPSW LI,R1 8 BAL,R15 WRTHEX BAL,R15 WRTOUT PLW,R15 WRKSTK B *R15 * FILES RES 0 PSW,R15 WRKSTK LI,R15 X'80' * SHWDRC RES 0 STW,R15 SHWSWT LCI 4 PSM,R2 WRKSTK LI,R0 10 STB,R0 SHWBFR LI,R0 KYWRTD MTW,0 SCNEOL BNEZ SHWFIL LW,R0 SHWSWT LI,R1 KYWUTL LI,R2 0 BAL,R15 OPNFIL LI,R0 KYWUTL * SHWFIL RES 0 STW,R0 SHWKYW LI,R13 HDRPAGE LI,R1 DRCHDR SAS,R1 -9 STH,R1 R13 STB,R0 R13 BAL,R14 G:COUPLE BNEZ SHWFLR * SHWSRC RES 0 LW,R3 SHWSWT STW,R3 SHWCNT LI,R3 8 * SHWFLP RES 0 LI,R2 -7 * SHWFLD RES 0 AI,R3 1 LB,R3 DRCHDR,R3 BEZ SHWOUF MI,R3 20 LW,R4 R3 MTW,0 SHWSWT BLEZ SHWDEL LW,R5 SHWMBS MBS,R4 BA(DRCHDR)+6 LI,R1 BA(SHWBFR) BAL,R15 WRTSEG BIR,R2 SHWFLD BAL,R15 WRTOUT B SHWFLP * SHWDEL RES 0 LW,R5 SHWMBD MBS,R4 BA(DRCHDR)+6 LD,R6 SHWPUB CBS,R6 0 BE SHWFLD LD,R6 SHWCMP CBS,R6 0 BE SHWFLD MTW,1 SHWCNT BLEZ SHWFLD LW,R0 SHWOPA+1 STW,R0 SHWOPD LW,R13 SHWOPA LW,R0 SHWKYW SLS,R0 4 STB,R0 R13 BAL,R14 G:OPEN BEZ SHWSRC MTW,-1 SHWSWT LI,R1 BA(MSGSHW) BAL,R15 WRTSEG LD,R6 SHWMSG MBS,R6 0 LI,R0 10 STB,R0 SHWBFR LI,R1 BA(SHWBFR) BAL,R15 WRTSEG BAL,R15 WRTOUT B SHWFLD * SHWFLR RES 0 LI,R1 BA(MSGFLR) B ERRXIT DESTROY RES 0 PSW,R15 WRKSTK LI,R15 0 B SHWDRC * PAGE * * * * ****************************** * * * * * FILE MANIPULATION ROUTINES * * * * * ****************************** * * * DATA,2 0,2 DATA,2 0,4 MNPTBL RES 0 MNPARG GEN,8,24 KYWPRG,MNPCAL+1 BOUND 8 MNPMBS DATA BA(FNMBFR) GEN,8,24 10,BA(MNPCAL)+10 MNPMS1 DATA X'C000C000' MNPMS2 DATA X'7' * FETCH RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LI,R0 0 STW,R0 MNPPRC LI,R0 KYWPRG BAL,R15 UTLGEN LI,R0 0 LI,R1 -KYWPRG LI,R2 KYWPRG BAL,R15 OPNFIL LI,R2 KYWRTD B MNPNAM * PUNCH RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LI,R0 -1 STW,R0 MNPPRC LI,R0 KYWUTL BAL,R15 UTLPUN B MNPFIL * PUNCHL RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LI,R0 -1 STW,R0 MNPPRC LI,R0 KYWUTL BAL,R15 UTLPNL B MNPFIL * PRINT RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LI,R0 -2 STW,R0 MNPPRC LI,R0 KYWUTL BAL,R15 UTLPRT B MNPFIL * ENTER RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LI,R0 0 STW,R0 MNPPRC LI,R0 0 LI,R1 KYWUTL LI,R2 0 BAL,R15 OPNFIL B MNPFIL * DELETE RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK MNPDEL RES 0 LI,R0 X'C0' LI,R1 -KYWUTL LI,R2 0 BAL,R15 OPNFIL MTW,0 SCNEOL BEZ MNPDEL LI,R13 KYWUTL BAL,R14 G:CLOSE CLOSE OUT DELETE KEYWORD B MNPXIT * GIVE RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LI,R0 0 STW,R0 MNPPRC LI,R0 KYWUTL BAL,R15 UTLGEN * MNPFIL RES 0 LI,R0 0 LI,R1 KYWPRG LI,R2 0 BAL,R15 OPNFIL LI,R2 KYWUTL * MNPNAM RES 0 MTW,0 SCNEOL BNEZ $+2 BAL,R15 FNMEVL SAS,R2 28 AW,R2 MNPARG STW,R2 MNPCAL LD,R2 MNPMBS MBS,R2 0 LW,R13 G:JOBNUM STH,R13 MNPCAL+2 LW,R13 G:ASLIFE AND,R13 MNPMS1 LW,R14 G:SECURE AND,R14 MNPMS2 SLS,R14 24 OR,R13 R14 STW,R13 MNPCAL+1 LW,R13 MNPCAL BAL,R14 G:ENTER BNEZ MNPERR LW,R1 MNPPRC BEZ MNPXIT LW,R13 MNPTBL,R1 BAL,R14 G:WAKEUP * MNPXIT RES 0 LCI 2 PLM,R2 WRKSTK PLW,R15 WRKSTK B *R15 * MNPERR RES 0 LI,R1 BA(MSGMNP) B ERRXIT * PAGE * * * * * ZAP RES 0 LI,R13 0 BAL,R14 G:DELETE CLEAR THE SCREEN B *R15 RETURN * PAGE * * * * **************** * * * * * TRAP HANDLER * * * * * **************** * * * BOUND 8 TRPMBF DATA BA(G:MSGCNT) GEN,8,24 132,BA(USRMCT) TRPADR DATA G:INTPSW LOCATION OF PSW AFTER INTERRUPT DATA G:ABRPSW LOCATION OF PSW AFTER ABORT * * ENTRY POINT FOR ABORTS: * TRPABR RES 0 MTW,1 TRPSWT SET ABORT/INTERRUPT SWITCH TO 1 * * ENTRY POINT FOR INTERRUPT: * TRPINT RES 0 MTW,0 USRSWT CHECK USER SWITCH BEZ TRPDBG * * TRAP CONDITION OCCURRED IN USER: * LCI 0 STM,R0 USRREG SAVE USER'S REGISTERS LW,R1 TRPSWT LW,R0 TRPADR,R1 LW,R0 *R0 GET PSW AT TIME OF TRAP STW,R0 USRPSW LD,R2 TRPMBF MBS,R2 0 SAVE CONTENTS OF MESSAGE BUFFER BAL,R15 TRPRST MTW,0 TRPSWT BEZ TRPUIN BAL,R15 BRKCHK WAS ABORT A BREAK POINT BLZ TRPUAB LW,R8 R0 LI,R1 BA(MSGBRK) BAL,R15 WRTSEG 'BREAK N XXXXXXXX XXXXXXXX' LW,R0 R8 LI,R1 1 BAL,R15 WRTHEX B TRPLOC * TRPUIN RES 0 BAL,R15 BRKCHK LI,R1 BA(MSGINT) BAL,R15 WRTSEG 'INTERRUPT XXXXXXXX XXXXXXXX' * TRPLOC RES 0 LW,R0 USRPSW LI,R1 8 BAL,R15 WRTHEX BAL,R15 WRTOUT B IDLPRG * TRPUAB RES 0 LI,R1 BA(MSGABR) BAL,R15 WRTSEG 'ABORT NN XXXXXXXX XXXXXXXX' * TRPABN RES 0 LW,R0 G:ABRNUM LI,R1 2 BAL,R15 WRTHEX B TRPLOC * * TRAP CONDITION OCCURRED IN GCLP: * TRPDBG RES 0 BAL,R15 TRPRST MTW,0 TRPSWT CHECK FOR ERROR IN GCLP BEZ TRPDIN LI,R1 BA(MSGERR) BAL,R15 WRTSEG 'ERROR NN XXXXXXXX XXXXXXXX' B TRPABN * TRPDIN RES 0 LI,R1 BA(MSGINT) BAL,R15 WRTSEG 'INTERRUPT' BAL,R15 WRTOUT B IDLPRG * TRPRST RES 0 LD,R2 IDLSTK STD,R2 WRKSTK LI,R13 TRPABR BAL,R14 G:SETABR LI,R13 TRPINT BAL,R14 G:SETINT LI,R13 0 STW,R13 USRSWT LI,R13 BA(WRTBFR) STW,R13 WRTPTR B *R15 * PAGE * * * * ******************* * * * * * OUTPUT ROUTINES * * * * * ******************* * * * SCS,0 0 SCS,0 4 SCS,0 8 SCS,0 12 SCS,0 16 SCS,0 20 SCS,0 24 SCS,0 28 WRTSHF RES 0 * BAWRTBFR DATA BA(WRTBFR) WRTMSK DATA X'7FFFF' WRTALF TEXT '0123456789ABCDEF' * WRTRST RES 0 LI,R0 BA(WRTBFR) STW,R0 WRTPTR B *R15 * WRTENT RES 0 LCI 2 PSM,R2 WRKSTK SAVE REGISTERS LI,R3 -1 STW,R3 WRTSWT SET BLANK SWITCH LW,R1 R1 IS (1) < 0 BGEZ $+3 MTW,1 WRTSWT LCW,R1 R1 AND,R1 WRTMSK LW,R3 WRTPTR POINTER TO OUTPUT LINE B *R14 * WRTBLK RES 0 MTW,0 WRTSWT BEZ WRTXIT LI,R2 KBL STB,R2 0,R3 PLACE BLANK AFTER SEGMENT MTW,1 R3 INCREMENT POINTER TO OUTPUT * WRTXIT RES 0 STW,R3 WRTPTR LCI 2 PLM,R2 WRKSTK B *R15 * WRTSEG RES 0 BAL,R14 WRTENT LB,R2 0,R1 NUMBER OF BYTES IN SEGMENT STB,R2 R3 STORE COUNT MTW,1 R1 INCREMENT TO BEG. OF STRING LW,R2 R1 POINTER TO SOURCE MBS,R2 0 MOVE INTO WRTBFR B WRTBLK * WRTCHR RES 0 BAL,R14 WRTENT STB,R0 0,R3 STORE CHARACTER IN OUTPUT MTW,1 R3 INCREMENT POINTER TO OUTPUT B WRTBLK * WRTOUT RES 0 BAL,R14 WRTENT LI,R0 KCR STB,R0 0,R3 TACK ON CARRIAGE RETURN MTW,1 R3 SW,R3 BAWRTBFR LI,R13 BA(WRTBFR) STB,R3 R13 BAL,R14 G:PRINT PRINT OUTPUT BUFFER LI,R3 BA(WRTBFR) B WRTXIT * WRTDEC RES 0 * * R0 CONTAINS NUMBER TO BE CONVERTED * R1 CONTAINS NUMBER OF DIGITS DESIRED * WRTHEX RES 0 BAL,R14 WRTENT LCW,R2 R1 EXU WRTSHF,R2 * WRTCNV RES 0 LI,R1 0 SCD,R0 4 LB,R1 WRTALF,R1 STB,R1 0,R3 MTW,1 R3 STORE CHARACTER IN OUTPUT BIR,R2 WRTCNV B WRTBLK * PAGE * * * * *********************** * * * * * BREAK POINT HANDLER * * * * * *********************** * * * BRKMSK DATA X'1FFFF' BOUND 8 BRKLIM DATA 0,15 * BREAK RES 0 PSW,R15 WRKSTK PSW,R2 WRKSTK MTW,0 SCNEOL CHECK FOR END OF LINE BLZ BRKDSP BAL,R15 EXPEVL CLM,R1 BRKLIM BCS,9 BRKERR LW,R2 R1 MTW,0 SCNEOL BLZ BRKDSS BAL,R15 EXPEVL GET ADDRESS AND,R1 BRKMSK STW,R1 BRKLOC,R2 * BRKDSS RES 0 LI,R1 BA(MSGBRK) BAL,R15 WRTSEG LW,R0 R2 LI,R1 1 BAL,R15 WRTHEX MTW,0 BRKLOC,R2 BLZ BRKDSZ LI,R0 KEQ LI,R1 1 BAL,R15 WRTCHR LW,R0 BRKLOC,R2 LI,R1 5 BAL,R15 WRTHEX BAL,R15 WRTOUT * BRKXIT RES 0 PLW,R2 WRKSTK BRKXTX RES 0 PLW,R15 WRKSTK B *R15 * BRKDSZ RES 0 LI,R1 BA(MSGBRZ) BAL,R15 WRTSEG BAL,R15 WRTOUT B BRKXIT * BRKDSP RES 0 LI,R2 -16 * BRKDSL RES 0 LW,R0 BRKLOC+16,R2 BLZ BRKDSX LI,R1 BA(MSGBRK) BAL,R15 WRTSEG LI,R1 1 LW,R0 R2 BAL,R15 WRTHEX LI,R0 KEQ LI,R1 1 BAL,R15 WRTCHR LW,R0 BRKLOC+16,R2 LI,R1 5 BAL,R15 WRTHEX BAL,R15 WRTOUT * BRKDSX RES 0 BIR,R2 BRKDSL B BRKXIT * BRKERR RES 0 LI,R1 BA(MSGIBP) B ERRXIT * CLEAR RES 0 PSW,R15 WRKSTK MTW,0 SCNEOL BLZ BRKCLR * BRKCLE RES 0 BAL,R15 EXPEVL CLM,R1 BRKLIM BCS,9 BRKERR LI,R0 -1 STW,R0 BRKLOC,R1 MTW,0 SCNEOL BGEZ BRKCLE B BRKXTX * BRKCLX RES 0 PSW,R15 WRKSTK SAVE RETURN ADDRESS BRKCLR RES 0 LI,R0 -1 LI,R1 -16 * BRKCLL RES 0 STW,R0 BRKLOC+16,R1 BIR,R1 BRKCLL B BRKXTX * BRKCHK RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LI,R1 -1 STW,R1 BRKNUM LI,R1 15 * BRKCHL RES 0 LW,R2 BRKVAL,R1 LW,R3 BRKLOC,R1 BLZ $+2 BAL,R15 USRPUT LW,R2 R3 LI,R3 X'1FFFF' CS,R2 USRPSW BNE $+2 STW,R1 BRKNUM SAVE BREAK NUMBER AI,R1 -1 BGEZ BRKCHL * LCI 2 PLM,R2 WRKSTK PLW,R15 WRKSTK LW,R0 BRKNUM B *R15 * BRKSET RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LI,R1 -16 * BRKSTL RES 0 LW,R3 BRKLOC+16,R1 BLZ BRKSTX BAL,R15 USRGET STW,R2 BRKVAL+16,R1 LI,R2 0 BAL,R15 USRPUT * BRKSTX RES 0 BIR,R1 BRKSTL LCI 2 PLM,R2 WRKSTK PLW,R15 WRKSTK B *R15 * PAGE * * * * **************************** * * * * * OPEN A GENERAL FILE NAME * * * * * **************************** * * * OPNDBT DATA X'00800000' BOUND 8 OPNMBS DATA BA(FNMBFR) GEN,8,24 10,BA(OPNARG)+10 OPNPUB DATA BA(OPNNAM) GEN,8,24 10,BA(OPNARG)+10 OPNNAM TEXT 'PUBLIC ' OPNPOF DATA BA(OPNAMP) GEN,8,24 10,BA(OPNARG)+10 OPNAMP TEXT 'POSTOFFICE' OPNGEN DATA BA(OPNAMG) GEN,8,24 10,BA(OPNARG)+10 OPNAMG TEXT 'GENERAL ' * OPNFIL RES 0 STW,R0 OPNACC STW,R1 OPNDEL LAW,R1 R1 STW,R1 OPNKYW STW,R2 OPNDIR LI,R0 OPNARG+1 STW,R0 OPNARG LI,R0 -1 STW,R0 OPNSWT PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK * OPNTRY RES 0 BAL,R15 FNMEVL GET FILE NAME * OPNRTR RES 0 LD,R2 OPNMBS MBS,R2 0 MOVE FILE NAME INTO OPEN ARGUMENT LW,R0 OPNACC GET ACCESS MTW,0 FNMSWT BNEZ $+2 LI,R0 0 START DIRECTORIES AT FULL ACCESS * OPNRTR1 RES 0 STB,R0 OPNARG+1 LW,R0 OPNKYW LW,R1 OPNSWT BGEZ OPNOPN LI,R0 X'C' MTW,0 OPNDIR BEZ $+2 LW,R0 OPNDIR DIRECTORY WAS SPECIFIED * OPNOPN RES 0 SAS,R0 4 AW,R0 OPNKYW STB,R0 OPNARG * OPNREA RES 0 LW,R13 OPNARG MTW,0 FNMSWT BEZ OPNCAL MTW,0 OPNDEL BGEZ OPNCAL AW,R13 OPNDBT * OPNCAL RES 0 BAL,R14 G:OPEN BEZ OPNCAL1 OK IF OPENED MTW,0 FNMSWT SEE IF CONCATENATED NAME BNEZ OPNERR IF NOT, THEN ACTUAL ERROR LB,R0 OPNARG+1 CI,R0 X'C0' SEE IF NO ACCESS WAS LAST BE OPNERR IF SO, GIVE UP AI,R0 X'40' OTHERWISE INCREMENT BY ONE B OPNRTR1 THEN TRY AGAIN * OPNCAL1 RES 0 MTW,1 OPNSWT MTW,0 FNMSWT WAS FILE NAME CONCATENATED BEZ OPNTRY LCI 2 PLM,R2 WRKSTK PLW,R15 WRKSTK B *R15 * OPNERR RES 0 MTW,0 OPNLDR BEZ OPNCHP LB,R0 OPNARG+1 CI,R0 0 BNE OPNCHP LI,R0 X'40' STB,R0 OPNARG+1 B OPNREA * OPNCHP RES 0 MTW,1 OPNSWT BEZ OPNTPB LI,R1 BA(MSGOPN) B ERRXIT * OPNTPB RES 0 MTW,0 OPNDIR WAS DIRECTORY SPECIFIED BGZ OPNERR LD,R2 OPNPUB MBS,R2 0 MOVE PUBLIC INTO OPEN ARGUMENT LI,R0 X'C0' AW,R0 OPNKYW STB,R0 OPNARG LI,R0 X'80' STB,R0 OPNARG+1 LW,R13 OPNARG BAL,R14 G:OPEN BEZ OPNRTR MTW,0 OPNDIR BEZ OPNERR LW,R0 OPNKYW SAS,R0 4 AW,R0 OPNKYW STB,R0 OPNARG LD,R2 OPNPOF MBS,R2 0 LW,R13 OPNARG BAL,R14 G:OPEN BNEZ OPNERR LD,R2 OPNGEN MBS,R2 0 LI,R13 X'C0' STB,R13 OPNARG+1 LW,R13 OPNARG BAL,R14 G:OPEN BNEZ OPNERR B OPNRTR * PAGE * * * * ************************* * * * * * UTILITY FILE ROUTINES * * * * * ************************* * * * UTLPUB OPEN_ KYWRTD,0,0,$+1,2 TEXT ' PUBLIC ' UTLPOF OPEN_ 0,0,0,$+1,2 TEXT ' POSTOFFICE' UTLMBX DATA UTLGND DATA UTLPRM DATA UTLPNM DATA UTLPLM * UTLGND GEN,2,30 3,0 TEXT ' GENERAL ' UTLPRM GEN,2,30 3,0 TEXT ' PRINTER ' UTLPNM GEN,2,30 3,0 TEXT ' PUNCH ' UTLPLM GEN,2,30 3,0 TEXT ' LONGPUNCH ' * UTLGEN RES 0 LI,R1 0 B UTLBGN * UTLPRT RES 0 LI,R1 1 B UTLBGN * UTLPUN RES 0 LI,R1 2 B UTLBGN * UTLPNL RES 0 LI,R1 3 * UTLBGN RES 0 SAS,R0 24 LW,R13 UTLPUB AW,R13 R0 BAL,R14 G:OPEN BNEZ UTLERR LW,R13 R0 SAS,R13 4 AW,R0 R13 LW,R13 UTLMBX,R1 AW,R13 R0 BAL,R14 G:OPEN BEZ *R15 * UTLERR RES 0 LI,R1 BA(MSGFLR) B ERRXIT * PAGE * * * * *********************** * * * * * EXECUTION PROCESSOR * * * * * *********************** * * * XECMVI GEN,8,24 128,BA(USRMBF) * PROCEED RES 0 LI,R0 0 B XECBGN * GO RES 0 LI,R0 1 * XECBGN RES 0 PSW,R15 WRKSTK STW,R0 XECSWT MTW,0 SCNEOL BNEZ XECPRC BAL,R15 EXPEVL STW,R1 USRPSW * XECPRC RES 0 MTW,0 XECSWT BNEZ XECUSR BAL,R15 USRSTP * XECUSR RES 0 BAL,R15 BRKSET MTW,0 FRTSWT BLZ XECRUN LW,R13 FRTABR BAL,R14 G:SETABR LW,R13 FRTABR+1 BAL,R14 G:SETINT LI,R0 -1 STW,R0 FRTSWT * XECRUN RES 0 LW,R13 XECMVI BAL,R14 G:MOVEIO LW,R13 XECMVI LW,R0 USRMCT STB,R0 R13 BAL,R14 G:MOVEIO LI,R0 1 STW,R0 USRSWT * XECLIB RES 0 LCI 0 LM,R0 USRREG LCF USRPSW B *USRPSW * STEP RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LI,R2 1 MTW,0 SCNEOL BNEZ XECSTP BAL,R15 EXPEVL LW,R2 R1 * XECSTP RES 0 BAL,R15 USRSTP BDR,R2 XECSTP LI,R1 BA(MSGPSD) BAL,R15 WRTSEG LW,R0 USRPSW LI,R1 8 BAL,R15 WRTHEX LW,R3 USRPSW BAL,R15 USRGET LW,R0 R2 LI,R1 8 BAL,R15 WRTHEX BAL,R15 WRTOUT LCI 2 PLM,R2 WRKSTK PLW,R15 WRKSTK B *R15 * PAGE * * * FILE EXECUTION AND LOADING * * * ROUTINE TO HANDLE THE MASTER COMMANDS: * * EXECUTE * LOAD * * GORDO EXECUTABLE FILES (OLD FLD FORMAT OR NEW XPL FORMAT) * ARE LOADED INTO VIRTUAL SPACE. IF THE PROCESS NUMBER IS * ONE (THE MASTER PROCESS) A SUBPROCESS IS FIRST FORKED OFF. * FILE PAGES ARE THEN COUPLED INTO VIRTUAL SPACE. PAGES OF * THE PROCESS SCRATCH FILE ARE USED FOR VIRTUAL PAGES WHICH * ARE TO BE COPIED FROM THE EXECUTABLE FILE OR WHICH CORRES- * POND TO UNINITIALIZED DATA AREAS. * * LOCAL L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12 LOCAL L13,L14 LOCAL NEWTYPE,OLDTYPE,FORK,TYPES,LOADER,STACK * BOUND 8 STACK RES 0 DATA XPLSTK+1 INITIAL STACK DOUBLEWORD DATA,2 512,0 * FORK RES 0 DATA NLZFRK PSW FOR FORKED SUBPROCESS DATA,2 X'FFFF',100 DATA 0 DATA,2 200,200 * DATA X'A0A0A0A0' XPL EXECUTABLE FORMAT DATA X'F0F0F0F0' FLD EXECUTABLE FORMAT TYPES RES 0 B NEWTYPE B OLDTYPE LOADER RES 0 * EXECUTE RES 0 LI,R0 0 CLEAR LOAD-ONLY FLAG B L0 READY TO BEGIN LOAD PROCESS LOAD RES 0 LI,R0 1 SET LOAD-ONLY FLAG B L0 * * (R0) = 0, IF EXECUTION IS TO PROCEED AFTER LOADING * 1, IF NO EXECUTION * L0 RES 0 STW,R0 LDRSWT SAVE LOAD-ONLY SWITCH FOR LATER TEST PSW,R15 WRKSTK SAVE RETURN ADDRESS LCI 2 PSM,R2 WRKSTK SAVE SCAN POINTER LI,R0 0 STW,R0 CMDMNT RESET MONITOR SWITCH LW,R0 G:PRCNUM LOAD PROCESS NUMBER CI,R0 1 CHECK FOR MASTER PROCESS BNE L3 BRANCH IF ALREADY IN SUBPROCESS BAL,R15 SCNRST BACKUP SCAN TO COMMAND LW,R13 SCNPTR LOAD SCAN POINTER MTW,+1 R13 INCREMENT TO NEXT CHARACTER LCW,R0 R13 COMPLEMENT FOR COMPUTATION AI,R0 BA(SCNBFR) ADD BUFFER ADDRESS FOR INITIAL COUNT AW,R0 SCNCNT FINALLY, GET REMAINING COUNT STB,R0 R13 THEN BUILD POINTER TO REMAINING LINE BAL,R14 G:MOVEIO RELOAD IN MESSAGE BUFFER LI,R13 FORK ARGUMENT FOR FORKING SUBPROCESS BAL,R14 G:FORK FORK THE SUBPROCESS BLZ L2 BRANCH ON FORK ERROR LW,R2 R13 PROCESS NUMBER FOR FORK LI,R1 BA(MSGPRC) BAL,R15 WRTSEG 'PROCESS NUMBER' LW,R0 R2 PROCESS NUMBER LI,R1 2 LENGTH OF FIELD BAL,R15 WRTHEX 'XX' LI,R1 BA(MSGFRK) BAL,R15 WRTSEG 'FORKED' BAL,R15 WRTOUT END OF MESSAGE LW,R13 R2 SUBPROCESS NUMBER BAL,R14 G:ASSINP ASSIGN CONSOLE TO PROCESS * L1 RES 0 LI,R0 1 STW,R0 CMDMNT SET SWITCH TO SCAN FOR COMMAND LCI 2 PLM,R2 WRKSTK RESTORE REGISTERS PLW,R15 WRKSTK RESTORE RETURN ADDRESS B *R15 RETURN * L2 RES 0 LI,R1 BA(MSGFRR) 'ERROR FORKING PROCESS' B ERRXIT * * SUBPROCESS HAS BEEN FORKED, READY TO OPEN FILE * L3 RES 0 BAL,R15 SCNSAV SAVE SCAN STATUS LI,R1 KYWPRG KEYWORD FOR OPENING PROGRAM FILE LI,R2 0 ASK FOR FULL ACCESS MTW,+1 OPNLDR SET LOADER SWITCH (SO EXECUTE OK) BAL,R15 OPNFIL OPEN FILE SPECIFIED IN COMMAND LINE LI,R5 KYWPRG KEYWORD (TO DISTINGUISH FROM LIBRARY) * LIBRARY RES 0 LI,R13 1 FILE PAGE LI,R0 XFLHDR ADDRESS OF HEADER SLS,R0 -9 SHIFT TO PAGE NUMBER STH,R0 R13 SET VIRTUAL PAGE STB,R5 R13 SET KEYWORD BAL,R14 G:COUPLE COUPLE FIRST PAGE OF PROGRAM FILE BNEZ L7 BRANCH IF ERROR LW,R0 XFLHDR LOOK AT FIRST WORD OF FILE LI,R1 TYPES-LOADER NUMBER OF FILE FORMATS * L4 RES 0 CW,R0 TYPES,R1 SCAN FOR KNOWN FILE TYPE BE LOADER,R1 IF FOUND, LOAD APPROPRIATELY BIR,R1 L4 KEEP SCANNING ALL KNOWN TYPES * L5 RES 0 CI,R5 KYWPRG ERROR--SEE IF LOADING LIBRARY BNE L6 SKIP IF YES LI,R1 BA(MSGLD1) 'FILE IS NOT EXECUTABLE' B ERRXIT * L6 RES 0 LI,R1 BA(MSGLD3) 'LIBRARY IS NOT EXECUTABLE' B ERRXIT * L7 RES 0 CI,R5 KYWPRG ERROR--SEE IF LOADING LIBRARY BNE L8 SKIP IF YES LI,R1 BA(MSGLD2) 'COUPLE ERROR LOADING FILE' B ERRXIT * L8 RES 0 LI,R1 BA(MSGLD4) 'COUPLE ERROR LOADING LIBRARY' B ERRXIT * * FILE HAS BEEN LOADED, READY FOR EXECUTION * L9 RES 0 LI,R3 X'1FFFF' MASK FOR INSTRUCTION ADDRESS STS,R2 USRPSW SET PSW TO EXECUTION START ADDRESS CI,R5 KYWPRG SEE IF LOADING LIBRARY BNE XECLIB ALL SET IF WE ARE LI,R1 NFCB-1 NUMBER OF FILE CONTROL BLOCKS LI,R0 0 CLEAR ALL TYPE FLAGS * L9A RES 0 STW,R0 FCBTYPE,R1 CLEAR LOGICAL UNIT ASSIGNMENT BDR,R1 L9A GET ALL OF THEM LI,R0 FCB:USED STW,R0 FCBTYPE+1 ASSIGN KEYWORD 1 TO PROGRAM LI,R13 XPLSTK ADDRESS OF STACK DOUBLEWORD STW,R13 USRREG PLACE INTO USER REGISTER 0 SLS,R13 -9 CONVERT TO PAGE NUMBER STH,R13 R13 USE AS VIRTUAL PAGE NUMBER MTW,+1 R13 INCREMENT BY ONE FOR SCRATCH PAGE LI,R0 KYWSCR KEYWORD FOR SCRATCH FILE STB,R0 R13 SET KEYWORD BAL,R14 G:COUPLE COUPLE IN STACK PAGE BNEZ L7 BRANCH IF COUPLE ERROR LD,R0 STACK INITIAL STACK DOUBLEWORD STD,R0 XPLSTK INITIALIZE THE RUN-TIME STACK LI,R0 MONITOR ADDRESS OF SUBMONITOR PSW,R0 XPLSTK PUSH LINK ADDRESS INTO STACK BAL,R15 SCNRST RESET SCAN POINTER TO FILE NAME LW,R12 SCNPTR LOAD SCAN POINTER MTW,+1 R12 INCREMENT TO NEXT CHARACTER LCW,R0 R12 COMPLEMENT FOR COMPUTATION AI,R0 BA(SCNBFR) ADD BUFFER ADDRESS FOR INITIAL COUNT AW,R0 SCNCNT FINALLY, GET REMAINING COUNT STW,R0 USRMCT SAVE AS USER'S LINE COUNT LI,R13 BA(USRMBF) ADDRESS OF USER'S MESSAGE BUFFER STB,R0 R13 SET BYTE COUNT FOR MOVE MBS,R12 0 PLACE REMAINING LINE IN USER'S BUFFER MTW,0 LDRSWT SEE IF LOAD-ONLY SWITCH SET BNEZ L1 ALL DONE IF IT IS * LI,R1 BA(MSGBGN) BAL,R15 WRTSEG 'BEGIN EXECUTION' BAL,R15 WRTOUT END OF MESSAGE LI,R0 -1 STW,R0 FRTSWT CLEAR FORTRAN INITIALIZATION SWITCH MTB,R0 OPNARG+1 THEN CHECK ACCESS OF LAST OPEN BEZ XECUSR IF FULL ACCESS READY TO GO BAL,R15 BRKCLX OTHERWISE CLEAR ALL BREAKPOINTS B XECUSR THEN BEGIN EXECUTIION * * SUBROUTINE TO LOAD FLD FILES * OLDTYPE RES 0 LW,R0 XFLFFP FIRST FILE PAGE LW,R1 XFLFVP FIRST VIRTUAL PAGE STH,R1 R0 BUILD COUPLE ARGUMENT STB,R5 R0 PLACE KEYWORD INTO ARGUMENT LCW,R1 XFLNVP NUMBER OF VIRTUAL PAGES LW,R2 XFLXSL EXECUTION START ADDRESS * L10 RES 0 LW,R13 R0 COUPLE ARGUMENT FOR NEXT PAGE BAL,R14 G:COUPLE COUPLE FILE PAGE INTO VIRTUAL SPACE BNEZ L5 BRANCH IF COUPLE ERROR AI,R0 X'10001' UPDATE COUPLE ARGUMENT BIR,R1 L10 PROCESS ENTIRE FILE B L9 FINISH UP LOADING * * SUBROUTINE TO LOAD XPL FILES * NEWTYPE RES 0 LI,R0 KYWSCR KEYWORD FOR SCRATCH FILE LI,R1 255 NUMBER OF VIRTUAL PAGES * * FMT ENTRIES PROCESSED: (ACTION,ACCESS,PAGE) * * ACTION = 0, NOTHING * 1, COUPLE PROGRAM PAGE * 2, COUPLE SCRATCH PAGE * 3, COUPLE SCRATCH AND COPY * L11 RES 0 LW,R13 XFLHDR+256,R1 FILE MEMORY TABLE ENTRY LB,R3 R13 FIRST BYTE IS ACTION BEZ L14 BRANCH IF NO ACTION CI,R3 1 CHECK FOR SIMPLE COUPLE BNE L12 BRANCH IF ANYTHING ELSE AI,R13 1 INCREMENT XPL RECORD NUMBER STH,R1 R13 SET UP VIRTUAL PAGE NUMBER STB,R5 R13 SET KEYWORD BAL,R14 G:COUPLE BNEZ L7 BRANCH IF COUPLE ERROR B L14 DONE WITH THIS ENTRY * L12 RES 0 CI,R3 3 CHECK FOR COPY BG L5 ERROR IF ILLEGAL ACTION LW,R13 R1 USE VIRTUAL PAGE NUMBER AI,R13 1 INCREMENT FOR SCRATCH PAGE NUMBER STH,R1 R13 SET VIRTUAL PAGE STB,R0 R13 KEYWORD FOR SCRATCH FILE BAL,R14 G:COUPLE COUPLE IN A SCRATCH PAGE BNEZ L7 BRANCH IF COUPLE ERROR CI,R3 3 SEE IF COPY WAS SPECIFIED BNE L14 IF NOT, DONE WITH THIS ENTRY LW,R13 XFLHDR+256,R1 RELOAD ENTRY AI,R13 1 INCREMENT XPL RECORD NUMBER LI,R3 XPLSTK ADDRESS OF COPY PAGE SLS,R3 -9 SHIFT TO PAGE NUMBER STH,R3 R13 SET VIRTUAL PAGE STB,R5 R13 SET PROGRAM KEYWORD BAL,R14 G:COUPLE COUPLE IN PROGRAM PAGE FOR COPY BNEZ L7 BRANCH IF COUPLE ERROR LW,R3 1 VIRTUAL PAGE NUMBER AI,R3 1 INCREMENT TO TOP-OF-PAGE SLS,R3 9 SHIFT TO WORD ADDRESS LI,R2 -256 NUMBER OF DOUBLWORDS IN A PAGE * L13 RES 0 LD,R14 XPLSTK+512,R2 DOUBLEWORD FROM PROGRAM PAGE STD,R14 *R3,R2 COPY INTO SCRATCH PAGE BIR,R2 L13 PROCESS ENTIRE PAGE * L14 RES 0 AI,R1 -1 GET NEXT VIRTUAL PAGE BGEZ L11 GO BACK AND DO REST LW,R2 XFLHDR+2 GET EXECUTION START ADDRESS B L9 FINISH LOADING * PAGE * * * XPL SUB-MONITOR * * * TABLE OF VALID SUBMONITOR SERVICES. THE SERVICE CALL NUMBER * FOR THE CAL IS ON THE TOP OF THE STACK. ONLY VALID SERVICE * REQUESTS ARE PROCESSED. ALL OTHERS CAUSE AN ABORT. * MONTBL B MONLIB . LOAD LIBRARY B MONRTX . READ TEXT B MONWTX . WRITE TEXT B MONDTM . DATE AND TIME B MONEXT . EXIT B MONRBN . READ BINARY B MONWBN . WRITE BINARY B MONSTR . START TRACE B MONETR . END TRACE B MONASU . ASSIGN UNIT B MONERX . ERROR EXIT MONMAX EQU $-MONTBL-1 NUMBER OF VALID SERVICE CODES * XPLBLANK TEXT ' ' BLANKS FOR BUFFER FILL. * MONITOR RES 0 LCI 0 STM,R0 XPLREG SAVE ALL USER REGISTERS PLW,R1 *XPLREG GET SERVICE TYPE CODE CI,R1 0 SEE IF CODE IS NON-NEGATIVE BGE MON1 OK IF GREATER THAN ZERO * MON0 RES 0 LI,R1 BA(MSGXP1) B MONERR 'ILLEGAL XPL SUBMONITOR CALL' * MON1 RES 0 CI,R1 MONMAX SEE IF CODE IS WITHIN RANGE BG MON0 ERROR IF TOO LARGE B MONTBL,R1 EXECUTE MONTOR CALL * MONXIT RES 0 ALL DONE WITH CALL LCI 0 LM,R0 XPLREG RESTORE ALL USER REGISTERS B *R15 RETURN TO XPL PROGRAM * MONERR RES 0 STW,R1 XPLMSG SAVE MESSAGE POINTER LCI 0 LM,R0 XPLREG LOAD USER'S REGISTERS LCI 0 STM,R0 USRREG SAVE FOR DEBUGGING LW,R1 XPLMSG RELOAD MESSAGE POINTER B ERRXIT * PAGE * * SUBMONITOR SERVICE CALL: LOAD LIBRARY (0) * * INPUT: (NONE) * * OUTPUT: (NONE) * * THIS CALL IS UNIMPLEMENTED. * MONLIB RES 0 B MON0 'ILLEGAL XPL SUBMONITOR CALL' * PAGE * * SUBMONITOR SERVICE CALL: READ TEXT (1) * * INPUT: LOGICAL UNIT NUMBER * FREESPACE POINTER * * OUTPUT: INPUT STRING (DESCRIPTOR) * UPDATED FREESPACE POINTER * * ONE LINE OF (EBCDIC) TEXT IS READ FROM THE SPECIFIED DEVICE. * IF THE DEVICE IS UNASSIGNED, AN ABORT OCCURS. * * * DURING THIS ROUTINE, THE REGISTERS ARE ALLOCATED AS: * * (R1) = BYTE INDEX INTO TEXT PAGE * (R2) = INDEX INTO FCB TABLES * (R3) = NEXT FREE BYTE IN STRING SPACE * (R4) = WORD ADDRESS OF TEXT PAGE * (R5) = WORD ADDRESS OF MAP PAGE * (R6) = UPDATE STRING SPACE POINTER (INITIAL+80) * MONRTX RES 0 LCI 2 PLM,R2 *XPLREG GET ARGUMENTS LW,R0 R2 LOGICAL UNIT NUMBER BAL,R15 FCBFIND FIND FCB FOR UNIT B MONW0 ERROR IF ILLEGAL UNIT LW,R7 R1 SAVE INDEX INTO FCB TABLES LW,R1 R3 BA(FREE SPACE) LI,R0 80 STB,R0 R1 LINE COUNT = 80 (ALWAYS) MBS,R0 BA(XPLBLANK) BLANK OUT THE LINE LW,R0 R3 GET FREE SPACE POINTER LI,R4 80 STB,R4 R0 SET COUNT IN DESCRIPTOR LCI 2 PSM,R0 *XPLREG RETURN ARGUMENTS: DESCRIPTOR, FREE LW,R6 R1 SAVE NEW FREE SPACE POINTER CI,R2 FCB:FILE CHECK FOR TEXT FILE OR CONSOLE BANZ MONR1 BRANCH IF THE CONSOLE CI,R2 FCB:IN SEE IF FILE HAS ATTRIBUTE INPUT BAZ MONW0 ERROR IF IT DOESN'T LW,R2 R7 GET INDEX INTO FCB LW,R1 FCBNEXT,R2 GET LINE POINTER LW,R4 FCBDATA,R2 ADDRESS OF PAGE * MON5 RES 0 LB,R7 *R4,R1 LOAD COUNT FOR LINE CI,R7 X'FE' BNE MON7 CHECK FOR END OF FILE LCI 2 PLM,R1 *XPLREG RELOAD OLD VALUES LI,R0 0 NULL DESCRIPTOR STB,R0 R1 OLD VALUE IS FREE SPACE LCI 2 PSM,R0 *XPLREG STORE NEW VALUES B MONXIT * MON6 RES 0 LI,R1 BA(MSGXP5) 'ERROR IN XPL TEXT READ' B MONERR * MON7 RES 0 MTW,+1 FCBLINE,R2 INCREMENT CURRENT LINE NUMBER CI,R7 X'FF' BNE MON8 MTW,1 FCBPAGE,R2 INCREMENT PAGE NUMBER LW,R1 FCBPAGE,R2 GET PAGE NUMBER AI,R1 9 CORRECT FOR INDEXING LW,R5 FCBMAP,R2 BASE ADDRESS FOR MAP PAGE LH,R13 *R5,R1 GET FILE PAGE LW,R0 FCBDATA,R2 ADDRESS OF TEXT BUFFER SLS,R0 -9 SHIFT TO PAGE NUMBER STH,R0 R13 SET VIRTUAL PAGE STB,R2 R13 BAL,R14 G:COUPLE COUPLE TEXT PAGE IN BNEZ MON6 LI,R1 0 RESET BYTE POINTER B MON5 NOW TRY AGAIN * MON8 RES 0 AI,R1 1 INCREMENT TO FIRST BYTE CI,R7 X'00' BE MON5 IGNORE ZEROS B MONC READY FOR FIRST CHARACTER * MON9 RES 0 CI,R7 X'FC' BNE MONA AI,R1 1 SKIP VERTICAL CONTROL AND NEXT BYTE B MONC CONTINUE * MONA RES 0 CI,R7 X'FD' BNE MOND LB,R0 *R4,R1 GET BLANK COUNT AI,R1 1 INCREMENT TO NEXT CHARACTER AW,R3 R0 UPDATE BUFFER POINTER * MONC RES 0 LB,R7 *R4,R1 GET NEXT BYTE AI,R1 1 INCREMENT TO NEXT CHARACTER B MON9 * MOND RES 0 CI,R7 KCR CARRIAGE RETURN BE MONF CI,R7 KEX ESCAPE CHARACTER BNE MONE LB,R7 *R4,R1 ESCAPED CHARACTER AI,R1 1 INCREMENT TO NEXT CHARACTER * MONE RES 0 CW,R3 R6 SEE IF MORE THAN 80 CHARACTERS BGE MONC DON'T STORE IF IT IS STB,R7 0,R3 PLACE INTO STRING AI,R3 1 INCREMENT DESCRIPTOR POINTER B MONC * MONF RES 0 STW,R1 FCBNEXT,R2 RESTORE LINE POINTER B MONXIT * MONR1 RES 0 BAL,R14 G:READ READ A LINE FROM CONSOLE KEYBOARD BGEZ MONR2 BRANCH IF LINE READY BAL,R14 G:SLEEP OTHERWISE SLEEP UNTIL INTERACTION B MONR1 THEN READ AGAIN * MONR2 RES 0 LI,R2 G:MSGBFR ADDRESS OF MESSAGE BUFFER SLS,R2 2 CONVERT TO BYTE ADDRESS LW,R1 G:MSGCNT GET LENGTH AI,R1 -1 DON'T COUNT CARRIAGE RETURN ON END CI,R1 80 SEE IF LONGER THAN ALLOWED BLE MONR3 SKIP IF OK LI,R1 80 MAXIMUM * MONR3 RES 0 STB,R1 R3 SET BYTE COUNT FOR MOVE MBS,R2 0 MOVE MESSAGE INTO DESCIPTOR B MONXIT RETURN * PAGE * * SUBMONITOR SERVICE CALL: WRITE TEXT (2) * * INPUT: LOGICAL UNIT NUMBER * OUTPUT STRING (DESCRIPTOR) * * OUTPUT: (NONE) * * ON LINE OF (EBCDIC) TEXT IS WRITTEN INTO THE SPECIFIED FILE * (OR THE CONSOLE). IF THE UNIT IS UNASSIGNED, AN ABORT OCCURS. * * DURING THIS ROUTINE, THE REGISTERS ARE ALLOCATED AS: * * (R1) = BYTE INDEX INTO TEXT PAGE * (R2) = INDEX INTO FCB TABLES * (R3) = STRING DESCRIPTOR * (R4) = BLANK COMPRESSION COUNT (-1,-N) * (R5) = BYTE INDEX TO START OF LINE * MONVFF TEXT ' 10' MONVFG DATA,1 0,X'F1',X'C1',0 MONVFC EQU 2 MONWXC DATA,1 0,KCR,KEX,X'FC',X'FD',X'FE',X'FF',0 LINELENG EQU 79 MAX LENGTH OF LINE TO G:PRINT * MONWTX RES 0 LCI 2 PLM,R2 *XPLREG GET ARGUMENTS LW,R0 R2 GET LOGICAL UNIT NUMBER LW,R10 R2 SAVE UNIT NUMBER FOR CHECK LATER BAL,R15 FCBFIND FIND FCB FOR UNIT B MONW0 ERROR IF NOT ASSIGNED CI,R2 FCB:FILE SEE IF CONSOLE WAS SELECTED BANZ MONW15 BRANCH IF IT IS CI,R2 FCB:TEXT CHECK FOR TEXT FILE BAZ MONW0 ERROR IF NOT TEXT FILE CI,R2 FCB:OUT CHECK FOR OUTPUT FILE BANZ MONW1 OK IF OUTPUT TEXT FILE * MONW0 RES 0 LI,R1 BA(MSGXP7) 'ILLEGAL XPL I/O UNIT' B MONERR * MONW1 RES 0 LI,R4 BA(TTBSTABL) CHECK STRING FOR ESCAPE CHARACTERS LW,R5 R3 GET DESCRIPTOR FOR STRING LI,R2 1 LOAD MASK STB,R2 R4 STORE MASK TTBS,R4 0 SET BIT 4 OF COND. CODE IF FOUND BL MONW1A * LI,R2 0 NO ESCAPE CHARS. B MONW1B * MONW1A RES 0 LI,R2 1 THERE ARE ESCAPE CHARS. * MONW1B STW,R2 ESCSWTCH LW,R2 R1 INDEX TO FCB INTO (R2) LW,R8 FCBMAP,R2 POINTER TO MAP PAGE LW,R9 FCBDATA,R2 POINTER TO DATA PAGE LW,R1 FCBNEXT,R2 GET BYTE POINTER FOR OUTPUT LI,R0 253 MAXIMUM LINE SIZE AW,R0 R1 ASSUME NO SQUEEZING CI,R0 2046 MUST LEAVE ROOM FOR TWO MORE BLE MONW3 OK IF IT FITS ON PRESENT PAGE LI,R0 X'FF' END OF PAGE MARK STB,R0 *R9,R1 SET END OF PAGE MARK IN CURRENT PAGE MTW,+1 FCBPAGE,R2 INCREMENT PAGE NUMBER LW,R1 FCBPAGE,R2 NUMBER OF PRESENT PAGE AI,R1 9 CORRECT FOR INDEXING LH,R13 *R8,R1 GET PAGE NUMBER FOR TEXT LW,R0 R9 ADDRESS OF DATA PAGE SLS,R0 -9 STH,R0 R13 STB,R2 R13 BAL,R14 G:COUPLE BEZ MONW2 LI,R1 BA(MSGXP6) B MONERR 'ERROR IN XPL WRITE' * MONW2 RES 0 LI,R0 X'FE' END OF FILE MARK STB,R0 *R9 UPDATE NEWEST PAGE LI,R1 0 NEW INDEX FOR TEXT * MONW3 RES 0 LW,R5 R1 SAVE START OF LINE AI,R5 252 INCREMENT TO MAXIMUM END LI,R4 -1 RESET BLANK COUNT AI,R1 1 CI,R10 0 SEE IF UNIT NUMBER ORIGINALLY 0 BNEZ MONW3A IF NOT CHECK FOR FORMAT CONTROL LI,R0 0 ASCII BLANK STB,R0 *R9,R1 PLACE INTO LINE AI,R1 1 INCREMENT TO NEXT CHARACTER LI,R4 0 SET BLANK TO ONE B MONW3D * MONW3A RES 0 MTB,0 R3 NULL LINE IS SPECIAL CASE BEZ MONW3D DON'T PUT OUT FORMAT CONTROL LW,R0 FCBTYPE,R2 GET TYPE FOR UNIT CI,R0 FCB:FRMT SEE IF FORMAT CONTROL SET BAZ MONW3D BRANCH IF NOT FORMAT CONTROL LI,R0 X'FC' VERTICAL CONTROL STB,R0 *R9,R1 PLACE AT START OF LINE LB,R7 0,R3 GET FIRST CHARACTER LI,R6 MONVFC NUMBER OF FORMAT CHARACTERS * MONW3B RES 0 CB,R7 MONVFF,R6 IS IT THIS ONE BE MONW3C BDR,R6 MONW3B IF NOT, KEEP LOOKING B MONW3D IF NOT ONE, IGNORE * MONW3C RES 0 LB,R0 MONVFG,R6 OTHERWISE GET GORDO CONTROL CODE AI,R1 1 STB,R0 *R9,R1 PLACE INTO LINE AI,R1 1 * MONW3D RES 0 LB,R0 R3 GET BYTE COUNT AI,R0 1 INCREMENT BY ONE FOR LOOP STB,R0 R3 SET COUNT INTO DESCRIPTOR * MONW4 RES 0 CW,R1 R5 SEE IF TOO MANY IN LINE ALREADY BGE MONW12 QUIT IF SO MTB,-1 R3 SEE IF ALL OF STRING DONE BEZ MONW12 LB,R7 0,R3 LOAD BYTE MTW,+1 R3 INCREMENT POINTER CI,R7 ' ' BNEZ MONW5 SKIP IF NOT BLANK AI,R4 1 INCREMENT BLANK COUNT BNEZ MONW4 B MONW11 * MONW5 RES 0 CI,R4 0 BLEZ MONW6 READY TO INSERT (NO BLANKS) AI,R1 -1 BACKSPACE OVER BLANK LI,R0 X'FD' STB,R0 *R9,R1 SET HORIZONTAL TAB AI,R1 1 AI,R4 1 INCREMENT FOR TRUE COUNT STB,R4 *R9,R1 SET COUNT AI,R1 1 INCREMENT POINTER * MONW6 RES 0 LI,R4 -1 RESET BLANK COUNT MTW,0 ESCSWTCH ARE THERE ANY ESCAPE CHARACTERS BEZ MONW11 IF NOT, DON'T CHECK LI,R6 6 NUMBER OF ESCAPED CHARACTERS * MONW9 RES 0 CB,R7 MONWXC,R6 SEE IF THIS IS ONE BE MONW10 BRANCH IF IT IS BDR,R6 MONW9 B MONW11 OTHERWISE READY TO PLACE IN TEXT * MONW10 RES 0 LI,R0 KEX ESCAPE CHARACTER STB,R0 *R9,R1 PLACE INTO TEXT AI,R1 1 INCREMENT POINTER * MONW11 RES 0 STB,R7 *R9,R1 PLACE INTO TEXT FILE AI,R1 1 INCREMENT POINTER B MONW4 GET NEXT CHARACTER * MONW12 RES 0 CI,R4 0 BL MONW13 AI,R1 -1 DECREMENT OVER PREVIOUS BLANK * MONW13 RES 0 LI,R0 KCR STB,R0 *R9,R1 PLACE CARRIAGE RETURN ON END LW,R0 R1 PRESENT POINTER AI,R5 -252 RECOVER START OF LINE POINTER SW,R0 R5 SUBTRACT ORIGINAL VALUE STB,R0 *R9,R5 PLACE AT START OF LINE AI,R1 1 INCREMENT LINE POINTER LI,R0 X'FE' END OF FILE MARK STB,R0 *R9,R1 STW,R1 FCBNEXT,R2 SAVE FOR NEXT CALL MTW,+1 FCBLINE,R2 INCREMENT NUMBER OF LINES IN FILE LI,R1 2 INDEX TO NUMBER OF LINES IN FILE LW,R0 FCBLINE,R2 CURRENT NUMBER OF LINES STW,R0 *R8,R1 UPDATE TEXT FILE LI,R1 1 INDEX TO LAST PAGE OF FILE LW,R0 FCBPAGE,R2 CURRENT PAGE OF FILE STW,R0 *R8,R1 UPDATE TEXT FILE B MONXIT ALL DONE * * WRITE OUT AN XPL DESCRIPTOR ON THE CONSOLE. * IF LONGER THAN 79 CHARS., SPLIT AND WRITE 2 * LINES. * MONW15 RES 0 WRITE ON SCREEN LB,R1 R3 GET BYTE COUNT BNEZ MONW16 BRANCH IF NOT NULL DESCRIPTOR * LI,R2 0 NULL DESC. - MUST WRITE 1 BLANK. STW,R2 WRTBFR LI,R13 BA(WRTBFR) FORM DESCRIPTOR POINTING TO BLANK LI,R2 1 LENGTH IS ONE STB,R2 R13 B MONW19 WRITE IT * MONW16 RES 0 GET RID OF TRAILING BLANKS. SINCE * XPL FORMS 80-CHARACTER LINES, AND * G:PRINT ACCEPTS 79 CHARS., WE MUST * AVOID PUTTING 2 LINES ON THE SCOPE * WHEN ONLY ONE LINE WAS WANTED. LW,R13 R3 COPY DESCRIPTOR MONW17 RES 0 AI,R1 -1 DECREMENT INDEX (START AT LAST BYTE) BEZ MONW18 IF ONE BLANK LEFT, DON'T DELETE IT LW,R3 R13 COPY DESCRIPTOR WHICH WAS DESTROYED AW,R3 R1 FORM BYTE ADDRESS LB,R2 0,R3 SEE IF BLANK BEZ MONW17 BRANCH IF IT IS * MONW18 RES 0 NOW SPLIT INTO 2 LINES IF > 79 CHAR. AI,R1 1 GET NEW LENGTH STB,R1 R13 STORE NEW LENGTH AI,R1 -LINELENG IS LENGTH <= 79 BLEZ MONW19 READY TO WRITE IF SO * LW,R3 R13 COPY DESCRIPTOR STB,R1 R3 STORE LENGTH OF REST LI,R1 LINELENG NO. CHARS ALLOWED BY G:PRINT AW,R3 R1 INCREMENT BEGINNING ADDR. OF REST STB,R1 R13 WRITE 79 CHARS. FOR FIRST PART BAL,R14 G:PRINT WRITE FIRST PART LW,R13 R3 READY TO WRITE REST * MONW19 RES 0 BAL,R14 G:PRINT OUTPUT DESCRIPTOR B MONXIT * PAGE * * SUBMONITOR SERVICE CALL: DATE AND TIME (3) * * INPUT: (NONE) * * OUTPUT: DATE AND TIME * * THE CURRENT DATE AND THE TIME-OF-DAY ARE RETURNED. * * MONTMS DATA X'0000FFFF' MASK FOR DAY MONFIV DATA X'00050000' FIVE FOR 'DH' INSTRUCTION MON24H DATA 8640000 CENTISECONDS IN A DAY * MONDTM RES 0 BAL,R14 G:CLOCK READ DATE AND TIME DH,R13 MONFIV TIME/5 FOR CENTISECONDS * MONDTM1 RES 0 CW,R13 MON24H CHECK FOR OVER TWENTY FOUR HOURS BL MONDTM2 OK IF IT IS SW,R13 MON24H OTHERWISE DECREMENT TIME AI,R12 1 INCREMENT DAY B MONDTM1 GO AGAIN * MONDTM2 RES 0 LI,R0 365 NUMBER OF DAYS IN YEAR CI,R12 X'30000' CHECK LOW BITS OF YEAR BANZ MONDTM3 SKIP IF NOT LEAP YEAR LI,R0 366 NUMBER OF DAYS IN LEAP YEAR * MONDTM3 RES 0 LI,R1 1 CH,R0 R12,R1 MAXIMUM AGAINST DAY BGE MONDTM4 SKIP IF OK SW,R12 R0 OTHERWISE DECREMENT DAY MTH,+1 R12 INCREMENT YEAR B MONDTM2 GO AGAIN * MONDTM4 RES 0 LI,R1 1000 LH,R0 R12 GET YEAR AI,R0 -1900 KEEP ONLY LOW TWO DIGITS MW,R1 R0 YEAR*1000 FOR DATE AND,R12 MONTMS KEEP ONLY DAY AW,R12 R1 COMPUTE YYDDD LCI 2 ARG(1) <== DATE PSM,R12 *XPLREG ARG(2) <== TIME B MONXIT ALL DONE * PAGE * * SUBMONITOR SERVICE CALL: EXIT (4) * * INPUT: DIAGNOSTIC VALUE * * OUTPUT: (NONE) * * A NORMAL EXIT IS PERFORMED FROM A PROGRAM. A MESSAGE IS * PLACED ON THE SCREEN AND THE MASTER RESUMES COMMAND MODE. * * MONEXT RES 0 LI,R1 BA(MSGXP8) BAL,R15 WRTSEG 'DIAGNOSTIC VALUE =' PLW,R0 *XPLREG GET DIAGNOSTIC VALUE CI,R0 0 IF 0, DON'T WRITE 'DIAG. VALUE' BEZ MONEXT1 * LI,R1 8 BAL,R15 WRTDEC WRITE IT OUT BAL,R15 WRTOUT * MONEXT1 RES 0 LI,R1 BA(MSGXP2) B MONERR 'NORMAL EXIT FROM XPL' * PAGE * * SUBMONITOR SERVICE CALLS: READ BINARY (5) * WRITE BINARY (6) * * INPUT: UNIT NUMBER * RECORD NUMBER * BUFFER * * OUTPUT: (NONE) * * ONE BINARY RECORD (512 WORDS--ONE PAGE) IS TRANSFERRED BETWEEN * THE ASSOCIATED BINARY FILE AND THE PROGRAM. THE FILE MUST * HAVE THE ATTRIBUTE OF BINARY AND IT MUST HAVE THE APPROPRIATE * ACCESS ATTRIBUTE. * MONRBN RES 0 LI,R3 FCB:IN SET READ SWITCH B MON10 * MONWBN RES 0 LI,R3 FCB:OUT SET WRITE SWITCH B MON10 * * (R3) = FCB:IN, IF READ OPERATION * FCB:OUT, IF WRITE OPERATION * MON10 RES 0 LCI 3 PLM,R10 *XPLREG LOAD ARGUMENTS LW,R0 R10 GET LOGICAL UNIT NUMBER BAL,R15 FCBFIND FIND FCB FOR LOGICAL UNIT B MONW0 ERROR IF UNIT NOT ASSIGNED CI,R2 FCB:TEXT+FCB:FILE SEE IF TEXT FILE BANZ MON10A ERROR IF NOT BINARY FILE CW,R2 R3 NOW CHECK FOR CORRECT ACCESS BAZ MON10A ERROR IF ACCESS NOT ALL RIGHT LW,R13 R11 FILE PAGE NUMBER AI,R13 1 *** OFFSET CORRECTION LI,R0 XPLBIN ADDRESS OF VIRTUAL PAGE SLS,R0 -9 GET PAGE NUMBER STH,R0 R13 STB,R1 R13 SET KEYWORD BAL,R14 G:COUPLE COUPLE IN PAGE BEZ MON11 OK IF NOT ERROR * MON10A RES 0 LI,R1 BA(MSGXP4) B MONERR 'ERROR IN XPL BINARY READ/WRITE' * MON11 RES 0 LI,R13 XPLBIN ADDRESS OF PAGE SLS,R13 2 SHIFT TO BYTE ADDRESS CI,R3 FCB:IN SEE IF INPUT OPERATION BAZ MON12 BRANCH IF WRITE (OUTPUT) XW,R12 R13 INTERCHANGE SOURCE AND DESTINATION * MON12 RES 0 LI,R1 8 LI,R0 255 * MON13 RES 0 STB,R0 R13 SET COUNT=255 MBS,R12 0 MOVE DATA BDR,R1 MON13 LI,R0 8 STB,R0 R13 COUNT=8 MBS,R12 0 MOVE LAST 8 BYTES B MONXIT * PAGE * * SUBMONITOR SERVICE CALL: START TRACE (7) * * INPUT: (NONE) * * THIS SERVICE IS CURRENTLY UNIMPLEMENTED. A MESSAGE IS PLACED * ON THE SCREEN BUT NO ACTION IS TAKEN. * MONSTR RES 0 LI,R1 BA(MSGXP10) BAL,R15 WRTSEG 'BEGIN XPL TRACE MODE' BAL,R15 WRTOUT B MONXIT * PAGE * * SUBMONITOR SERVICE CALL: END TRACE (8) * * INPUT: (NONE) * * OUTPUT: (NONE) * * THIS SERVICE IS CURRENTLY UNIMPLEMENTED. A MESSAGE IS PLACED * ON THE SCREEN BUT NO ACTION IS TAKEN. * MONETR RES 0 LI,R1 BA(MSGXP11) BAL,R15 WRTSEG 'TERMINATE XPL TRACE MODE' BAL,R15 WRTOUT B MONXIT * PAGE * * SUBMONITOR SERVICE CALL: ASSIGN UNIT (9) * * INPUT: FILE TYPE * LOGICAL UNIT NUMBER * FILE NAME (DESCRIPTOR) * * OUTPUT: 0, IF ASSIGN MADE * 1, OTHERWISE * * A FILE (OR THE CONSOLE) IS ASSIGNED TO A LOGICAL I/O UNIT. IF * THE UNIT NUMBER HAS BEEN PREVIOUSLY ASSIGNED THE OLD ASSIGNMENT * IS SUPERSEDED. IF THE CONSOLE HAS BEEN PREVIOUSLY ASSIGNED THE * OLD ASSIGNMENT IS SUPERSEDED. * LOCAL MONASU1,MONASU2,MONASU3,MONASU4,MONASU5,MONASU6 LOCAL MONASU7,MONASU8,MONASU9,MONASU10,MONASU11,MONASU12 LOCAL MONASU13 LOCAL FCBBITS,FCBMBS,FCBHEAD * FCBMBS GEN,8,24 10,BA(FCBOPN)+10 FILE NAME IN OPEN BLOCK BOUND 8 FCBBITS DATA X'7F' VALID TYPE BITS FOR FCB FCBHEAD DATA X'E0E0E0E0' TEXT FILE HEADER * MONASU RES 0 LCI 3 PLM,R4 *XPLREG GET ARGUMENTS (DESC,UNIT,TYPE) AND,R6 FCBBITS KEEP ONLY VALID FCB BITS AI,R6 FCB:USED TURN ON IN-USE BIT LW,R0 R5 GET LOGICAL UNIT NUMBER BAL,R15 FCBFIND FIND FCB FOR UNIT B MONASU1 OK IF NOT FOUND LI,R2 0 STW,R2 FCBTYPE,R1 IF FOUND DELETE ENTRY * MONASU1 RES 0 CI,R6 FCB:FILE SEE IF A FILE IS REQUESTED BAZ MONASU4 BRANCH IF IT IS A FILE STW,R0 FCBUNIT SET NEW UNIT NUMBER FOR CONSOLE STW,R6 FCBTYPE SET TYPE FLAGS FOR CONSOLE * MONASU2 RES 0 LI,R0 0 SUCCESSFUL COMPLETEION * MONASU3 RES 0 PSW,R0 *XPLREG PUSH RETURN CODE ONTO STACK B MONXIT EXIT * MONASU4 RES 0 LI,R7 NFCB-1 NUMBER OF FCB'S * MONASU5 RES 0 MTW,0 FCBTYPE,R7 SEE IF KEYWORD UNASSIGNED BEZ MONASU7 OK IF ONE FOUND BDR,R7 MONASU5 OTHERWISE KEEP SCANNING FOR EMPTY * MONASU6 RES 0 LI,R0 1 ERROR CONDITION B MONASU3 UNSUCCESSFUL RETURN * MONASU7 RES 0 STW,R0 FCBUNIT,R7 SET LOGICAL UNIT NUMBER STW,R6 FCBTYPE,R7 SET TYPE LW,R1 FCBMBS MBS TO CLEAR FILE NAME MBS,R0 BA(XPLBLANK) CLEAR FILE NAME FROM OPEN BLOCK LB,R0 R4 LENGTH FROM DESCRIPTOR CI,R0 10 NO MORE THAN TEN CHARACTERS BLE MONASU8 OK IF NOT TOO MANY LI,R0 10 OTHERWISE TRUNCATE * MONASU8 RES 0 LW,R5 FCBMBS ADDRESS OF FILE NAME STB,R0 R5 SET LENGTH MBS,R4 0 MOVE NAME FROM STRING LI,R0 0 FULL ACCESS (FOR WRITE) CI,R6 FCB:OUT SEE IF OUTPUT BANZ MONASU9 ACCESS CORRECT IF OUTPUT FILE LI,R0 X'80' READ ACCESS * MONASU9 RES 0 AW,R0 G:SECURE ADD IN SECURITY LEVEL STB,R0 FCBOPN+1 SET ACCESS INTO OPEN BLOCK LW,R0 R7 GET KEYWORD AI,R0 X'C0' OPEN FROM ROOT DIRECTORY LI,R13 FCBOPN+1 ARGUMENT TO OPEN STB,R0 R13 SET KEYWORDS FOR OPEN BAL,R14 G:OPEN TRY TO OPEN FILE FROM PUBLIC BEZ MONASU11 ALL SET IF SUCCESSFUL LW,R13 UTLPUB OPEN ARGUMENT FOR PUBLIC STB,R0 R13 SET KEYWORDS BAL,R14 G:OPEN OPEN PUBLIC LW,R1 R7 KEYWORD FOR FILE SLS,R1 4 AW,R1 R7 USE FOR BOTH KEYWORDS LI,R13 UTLGND ARGUMENT FOR GENERAL STB,R1 R13 SET KEYWORDS BAL,R14 G:OPEN OPEN UP GENERAL LI,R13 FCBOPN+1 GET OPEN ARGUMENT STB,R1 R13 SET KEYWORDS BAL,R14 G:OPEN TRY TO OPEN FROM GENERAL BEZ MONASU10 FOUND IT, NOW ENTER LW,R13 UTLPUB OPEN FOR PUBLIC STB,R0 R13 BAL,R14 G:OPEN OPEN UP PUBLIC LI,R13 FCBOPN+1 ARGUMENT TO OPEN FILE STB,R1 R13 SET KEYWORDS BAL,R14 G:OPEN TRY TO OPEN FILE FROM PUBLIC BEZ MONASU10 IF OPENED, READY TO ENTER CI,R6 FCB:NEW SEE IF NEW FILE SHOULD BE CREATED BAZ MONASU6 ERROR RETURN IF NOT LI,R13 1000 MAXIMUM NUMBER OF PAGES STH,R7 R13 SET KEYWORD FOR CREATE LB,R1 FCBOPN+1 GET ACCESS AND SECURITY STB,R1 R13 SET INTO ARGUMENT BAL,R14 G:CREATE THEN CREATE A SCRATCH FILE BNEZ MONASU6 ERROR IF UNABLE TO CREATE FILE * MONASU10 RES 0 CI,R6 FCB:ROOT SEE IF SHOULD ENTER FILE IN ROOT DIR BANZ MONASU11 BRANCH IF NOT LI,R13 FCBOPN+1 ARGUMENT TO ENTER STB,R0 R13 SET KEYWORDS FOR ROOT BAL,R14 G:ENTER ENTER FILE INTO ROOT * MONASU11 RES 0 CI,R6 FCB:TEXT SEE IF A TEXT FILE BAZ MONASU2 ALL FINISHED IF NOT LI,R0 XPLMAP ADDRESS FOR MAP PAGES SLS,R0 -9 CONVERT TO PAGE NUMBER AW,R0 R7 GET APPROPRIATE ONE FOR THIS FILE LI,R13 1 FILE PAGE OF MAP STH,R0 R13 SET VIRTUAL PAGE SLS,R0 9 BACK TO WORD ADDRESS STW,R0 FCBMAP,R7 SET POINTER IN FCB STB,R7 R13 SET KEYWORD FOR COUPLE BAL,R14 G:COUPLE COUPLE DOWN THE MAP PAGE BNEZ MONASU6 ERROR IF UNABLE TO COUPLE LI,R8 0 FLAG SAYING ALREADY A TEXT FILE LW,R1 FCBHEAD SEE IF FILE IS TYPED AS TEXT CW,R1 *R0 GET FIRST WORD OF MAP PAGE BE MONASU13 SKIP IF ALREADY A TEXT FILE LI,R8 1 CLEAR TEXT FILE FLAG STW,R1 *R0 SET HEADER INTO FILE AI,R0 1 POINT TO LAST PAGE INDEX LI,R1 1 STW,R1 *R0 FIRST TEXT PAGE IS LAST ONE AI,R0 1 POINT TO LINE COUNT LI,R1 0 STW,R1 *R0 FILE INITIALLY HAS NO LINES AI,R0 502 POINT JUST BEYOND MAP PAGE LI,R1 X'20003' FIRST MAP ENTRY LI,R2 -499 NUMBER OF WORDS IN MAP * MONASU12 RES 0 STW,R1 *R0,R2 SET MAP ENTRY AI,R1 X'20002' UPDATE MAP ENTRY BIR,R2 MONASU12 INITIALIZE ENTIRE PAGE MAP * MONASU13 RES 0 LI,R0 0 STW,R0 FCBLINE,R7 BEGIN AFTER LINE 0 STW,R0 FCBNEXT,R7 BEGIN AT START OF PAGE LI,R0 1 STW,R0 FCBPAGE,R7 BEGIN AT FIRST PAGE LI,R13 2 FILE PAGE NUMBER LI,R0 XPLDATA ADDRESS OF TEXT PAGE SLS,R0 -9 CONVERT TO PAGE NUMBER AW,R0 R7 GET ONE FOR THIS FILE STH,R0 R13 SET FILE PAGE NUMBER SLS,R0 9 SHIFT BACK TO WORD ADDRESS STW,R0 FCBDATA,R7 SET POINTER IN FCB STB,R7 R13 SET KEYWORD IN ARGUMENT BAL,R14 G:COUPLE COUPLE IN DATA PAGE BNEZ MONASU6 ERROR IF UNABLE TO COUPLE CI,R8 0 SEE IF TEXT FILE BEING FORMATTED BEZ MONASU2 DONE IF NOT LI,R8 X'FE' END-OF-FILE MARK STB,R8 *R0 SETUP DATA PAGE FOR NEW TEXT FILE B MONASU2 END OF SUCCESSFUL ASSIGN * PAGE * * SUBMONITOR SERVICE CALL: ERROR EXIT (10) * * INPUT: SOURCE LINE NUMBER * * OUTPUT: (NONE) * * AN ABNORMAL EXIT IS PERFORMED FROM THE PROGRAM. THE SOURCE * LINE NUMBER IS PLACED ON THE SCREEN AND THE MASTER RESUMES * COMMAND MODE. * MONERX RES 0 LI,R1 BA(MSGXP9) BAL,R15 WRTSEG 'SOURCE LINE NUMBER =' PLW,R0 *XPLREG LI,R1 5 BAL,R15 WRTDEC WRITE OUT SOURCE LINE NUMBER BAL,R15 WRTOUT LI,R1 BA(MSGXP3) B MONERR 'ERROR EXIT FROM XPL' * PAGE * * FIND FCB FOR LOGICAL UNIT * * INPUT: (R0) = LOGICAL UNIT NUMBER * (R15) = RETURN ADDRESS * * OUTPUT: (R0) = LOGICAL UNIT (0 CHANGED TO 1) * (R1) = INDEX INTO FCB TABLES * (R2) = TYPE FLAGS FOR UNIT * * THE FCB TABLES ARE SCANNED, CHECKING FOR AN ASSIGNED UNIT * MATCHING THE LOGICAL UNIT NUMBER. UNIT NUMBER 0 IS EQUIVALENT * TO UNIT NUMBER 1. * LOCAL F1,F2,F3,F4 * FCBFIND RES 0 CI,R0 0 SEE IF LOGICAL UNIT ZERO BNEZ F1 OK IF IT ISN'T LI,R0 1 OTHERWISE CHANGE TO ONE * F1 RES 0 LI,R1 NFCB-1 NUMBER OF FCB'S * F2 RES 0 LW,R2 FCBTYPE,R1 LOOK AT TYPE FOR ENTRY CI,R2 FCB:USED SEE IF THIS KEYWORD IS ASSIGNED BAZ F3 SKIP IF NOT ASSIGNED CW,R0 FCBUNIT,R1 OTHERWISE CHECK UNIT NUMBER BE F4 SUCCESS IF FOUND * F3 RES 0 MTW,-1 R1 TRY NEXT FCB BGEZ F2 B *R15 UNSUCCESSFUL RETURN * F4 RES 0 MTW,+1 R15 INCREMENT TO SUCCESS B *R15 RETURN * PAGE * * * * *********************** * * * * * USER CORE INTERFACE * * * * * *********************** * * * BOUND 8 USRMBS DATA BA(G:MSGCNT) GEN,8,24 132,BA(USRMCT) USRMSK DATA X'1FFFF' * USRGET RES 0 AND,R3 USRMSK CI,R3 16 BL USRGTR LW,R2 *R3 B *R15 * USRGTR RES 0 LW,R2 USRREG,R3 B *R15 * USRPUT RES 0 AND,R3 USRMSK CI,R3 16 BL USRPTR STW,R2 *R3 B *R15 * USRPTR RES 0 STW,R2 USRREG,R3 B *R15 * USRTBL RES 0 B USRBRA B USRBRA B USRXEC B USREXU B USRBRA B USRBRA B USRBAL BOUND 8 * USRBRK BDR,R0 0 BAL,R0 0 USREAD DATA X'800FFFFF' USRRGM DATA X'F' USRBRX B USRBRS USROPM DATA X'7F000000' * USRSTP RES 0 PSW,R15 WRKSTK LCI 2 PSM,R2 WRKSTK LW,R3 USRPSW * USRCHK RES 0 BAL,R15 USRGET STW,R2 USRINS LW,R3 USROPM LS,R3 R2 CLM,R3 USRBRK BCS,9 USRXEC SW,R3 USRBRK SAS,R3 -24 B USRTBL,R3 * USREXU RES 0 LCI 15 PSM,R1 WRKSTK LCI 0 LM,R0 USRREG ANLZ,R0 USRINS LCI 15 PLM,R1 WRKSTK LW,R3 R0 B USRCHK * USRBAL RES 0 LCI 15 PSM,R1 WRKSTK LCI 0 LM,R0 USRREG ANLZ,R0 USRINS LCI 15 PLM,R1 WRKSTK MTW,1 USRPSW LW,R1 USRPSW AND,R1 USRMSK LW,R3 R2 SAS,R3 -20 AND,R3 USRRGM STW,R1 USRREG,R3 LW,R1 USRMSK STS,R0 USRPSW AND,R0 R1 CI,R0 X'1E000' BL USRXIT DONE IF NOT SYSTEM CALL * USRSYS RES 0 LW,R13 XECMVI BAL,R14 G:MOVEIO LW,R13 XECMVI LW,R0 USRMCT STB,R0 R13 BAL,R14 G:MOVEIO LW,R0 USRREG+14 LW,R13 USRREG+13 BAL,R14 *USRPSW STCF 0 STW,R13 USRREG+13 STW,R0 USRPSW LD,R2 USRMBS MBS,R2 0 B USRXIT * USRBRA RES 0 LCI 15 PSM,R1 WRKSTK LCI 0 LM,R0 USRREG ANLZ,R0 USRINS LCI 15 PLM,R1 WRKSTK LW,R3 USREAD LS,R2 USRBRX STW,R2 USRINS LW,R2 R0 * USRXEC RES 0 LW,R13 XECMVI BAL,R14 G:MOVEIO LW,R13 XECMVI LW,R0 USRMCT STB,R0 R13 BAL,R14 G:MOVEIO LCI 0 PSM,R0 WRKSTK LCI 0 LM,R0 USRREG LCF USRPSW EXU USRINS STCF USRPSW LCI 0 STM,R0 USRREG LCI 0 PLM,R0 WRKSTK MTW,1 USRPSW LD,R2 USRMBS MBS,R2 0 B USRXIT * USRBRS RES 0 STCF USRPSW LCI 0 STM,R0 USRREG LCI 0 PLM,R0 WRKSTK LW,R3 USRMSK STS,R2 USRPSW CI,R0 X'1E000' BGE USRSYS * USRXIT RES 0 LCI 2 PLM,R2 WRKSTK PLW,R15 WRKSTK B *R15 * PAGE * * * * ************************* * * * * * SYSTEM CALL PROCESSOR * * * * * ************************* * * * ARG EQU 0 NULL EQU 32 DONE EQU 0 WORD EQU -1 FILE EQU -2 * SYSMSK RES 0 DATA X'00000000' DATA X'00000001' DATA X'00000003' DATA X'00000007' DATA X'0000000F' DATA X'0000001F' DATA X'0000003F' DATA X'0000007F' DATA X'000000FF' DATA X'000001FF' DATA X'000003FF' DATA X'000007FF' DATA X'00000FFF' DATA X'00001FFF' DATA X'00003FFF' DATA X'00007FFF' DATA X'0000FFFF' DATA X'0001FFFF' DATA X'0003FFFF' DATA X'0007FFFF' DATA X'000FFFFF' DATA X'001FFFFF' DATA X'003FFFFF' DATA X'007FFFFF' DATA X'00FFFFFF' DATA X'01FFFFFF' DATA X'03FFFFFF' DATA X'07FFFFFF' DATA X'0FFFFFFF' DATA X'1FFFFFFF' DATA X'3FFFFFFF' DATA X'7FFFFFFF' DATA X'FFFFFFFF' SYSTP0 DATA,1 DONE SYSTP1 DATA,1 ARG+32 DATA,1 DONE SYSTP2 DATA,1 ARG+16 DATA,1 ARG+16 DATA,1 DONE SYSTP3 DATA,1 ARG+8 DATA,1 ARG+24 DATA,1 DONE SYSTP4 DATA,1 ARG+4 DATA,1 ARG+4 DATA,1 ARG+1 DATA,1 NULL+23 DATA,1 WORD DATA,1 ARG+2 DATA,1 NULL+30 DATA,1 FILE SYSTP5 DATA,1 ARG+4 DATA,1 ARG+4 DATA,1 NULL+24 DATA,1 WORD DATA,1 ARG+2 DATA,1 NULL+3 DATA,1 ARG+3 DATA,1 NULL+8 DATA,1 ARG+2 DATA,1 NULL+14 DATA,1 WORD DATA,1 ARG+16 DATA,1 NULL+16 DATA,1 FILE SYSTP6 DATA,1 ARG+2 DATA,1 NULL+2 DATA,1 ARG+1 DATA,1 ARG+3 SECURITY DATA,1 ARG+4 TYPE DATA,1 ARG+4 KEYWORD DATA,1 ARG+16 PAGE COUNT DATA,1 DONE SYSTP7 DATA,1 WORD (NO ARGUMENTS IN VALUE CELL) DATA,1 ARG+32 DATA,1 WORD DATA,1 ARG+16 LONG QUANTUM DATA,1 ARG+16 SHORT QUANTUM DATA,1 DONE SYSTP8 DATA,1 WORD (NO ARGUMENTS IN VALUE CELL) DATA,1 ARG+32 PROCESS NUMBER DATA,1 ARG+16 JOB NUMBER DATA,1 ARG+16 PROCESS NUMBER DATA,1 WORD DATA,1 ARG+32 KEYWORD DATA,1 DONE SYSTP9 DATA,1 WORD (NO ARGUMENT IN VALUE CELL) DATA,1 ARG+32 PROCESS NUMBER DATA,1 WORD DATA,1 ARG+32 PSW DATA,1 DONE SYSTPA DATA,1 WORD (NO ARGUMENT IN VALUE CELL) DATA,1 ARG+32 PSW DATA,1 WORD DATA,1 ARG+16 KEYWORD ENABLE BITS DATA,1 ARG+16 FREE PAGES DATA,1 WORD DATA,1 ARG+32 EXECUTION TIME DATA,1 ARG+16 LONG QUANTUM DATA,1 ARG+16 SHORT QUANTUM DATA,1 DONE SYSTPB DATA,1 WORD (NO ARGUMENT IN VALUE CELL) DATA,1 ARG+32 PSW DATA,1 WORD DATA,1 ARG+16 KEYWORD ENABLE BITS DATA,1 ARG+16 FREE PAGES DATA,1 WORD DATA,1 ARG+32 EXECUTION TIME DATA,1 WORD DATA,1 ARG+16 LONG QUANTUM DATA,1 ARG+16 SHORT QUANTUM DATA,1 WORD DATA,1 ARG+32 JOB NUMBER DATA,1 WORD DATA,1 ARG+32 SYSTEM BIT DATA,1 WORD DATA,1 ARG+32 SECURITY DATA,1 WORD DATA,1 ARG+32 COMPUTATION FILE KEYWORD DATA,1 DONE SYSTPC DATA,1 ARG+8 DATA,1 ARG+8 DATA,1 ARG+16 DATA,1 DONE BOUND 8 SYSTBS RES 0 TEXT 'ENTER ' TEXT 'CREATE ' TEXT 'COUPLE ' TEXT 'CLOSE ' TEXT 'STATUS ' TEXT 'LOCK ' TEXT 'UNLOCK ' TEXT 'REALADDR' TEXT 'OPEN ' TEXT 'SLEEP ' TEXT 'WAKEUP ' SYSTBL DATA DA(SYSTBS)-DA(SYSTBL) DATA G:ENTER DATA G:CREATE DATA G:COUPLE DATA G:CLOSE DATA G:STATUS DATA G:LOCK DATA G:UNLOCK DATA G:REALAD DATA G:OPEN DATA G:SLEEP DATA G:WAKEUP SYSLOC RES 0 DATA BA(SYSTP5) DATA BA(SYSTP6) DATA BA(SYSTPC) DATA BA(SYSTP1) DATA BA(SYSTP0) DATA BA(SYSTP1) DATA BA(SYSTP1) DATA BA(SYSTP1) DATA BA(SYSTP4) DATA BA(SYSTP0) DATA BA(SYSTP2) SYSFRM RES 0 SYSADR DATA X'1FFFF' BOUND 8 SYSPTR DATA SYSREG-1 DATA,2 10,0 SYSMBS DATA BA(FNMBFR) GEN,8,24 10,BA(SYSREG)+10 * B SYSFNM B SYSWRD SYSOPR B SYSDON * CALL RES 0 PSW,R15 WRKSTK LCI 6 PSM,R2 WRKSTK BAL,R15 SCNSAV SAVE STATUS OF SCANNER LI,R0 SYSTBL BAL,R15 TKNEVL GET TOKEN BNEZ SYSTKN BAL,R15 SCNRST BAL,R15 EXPEVL STW,R1 SYSBAL LI,R3 0 MTW,0 SCNEOL BNEZ SYSDON * SYSRDM RES 0 BAL,R15 EXPEVL PSW,R1 SYSVAL BCS,11 SYSERR MTW,0 SCNEOL BNEZ SYSCHK B SYSRDM * SYSTKN RES 0 LW,R0 SYSLOC,R1 GET ADDRESS OF SYSTEM CALL LW,R2 SYSFRM,R1 * SYSCAL RES 0 STW,R0 SYSBAL LD,R0 SYSPTR STD,R0 SYSVAL LI,R3 0 * SYSARG RES 0 LB,R4 0,R2 MTW,1 R2 STB,R4 R4 SAS,R4 -24 LW,R4 R4 BLEZ SYSOPR,R4 CI,R4 32 BLE SYSEXP AI,R4 -32 LI,R1 0 B SYSFIL * SYSEXP RES 0 BAL,R15 EXPEVL * SYSFIL RES 0 AND,R1 SYSMSK,R4 SAS,R3 0,R4 OR,R3 R1 B SYSARG * SYSWRD RES 0 PSW,R3 SYSVAL LI,R3 0 B SYSARG * SYSFNM RES 0 PSW,R3 SYSVAL BAL,R15 FNMEVL LD,R2 SYSMBS MBS,R2 0 B SYSCHK * SYSDON RES 0 PSW,R3 SYSVAL * SYSCHK RES 0 LW,R0 SYSVAL CI,R0 SYSREG BE SYSEXU LI,R0 SYSREG+1 LW,R1 SYSADR STS,R0 SYSREG * SYSEXU RES 0 LW,R13 XECMVI BAL,R14 G:MOVEIO LW,R13 XECMVI LW,R0 USRMCT STB,R0 R13 BAL,R14 G:MOVEIO LW,R13 SYSREG BAL,R14 *SYSBAL LW,R4 R13 LD,R2 USRMBS MBS,R2 0 LI,R1 BA(MSGSYS) BAL,R15 WRTSEG LW,R0 R4 LI,R1 8 BAL,R15 WRTHEX BAL,R15 WRTOUT LCI 6 PLM,R2 WRKSTK PLW,R15 WRKSTK B *R15 * SYSERR RES 0 LI,R1 BA(MSGARG) B ERRXIT * PAGE * * * * ************************** * * * * * SERVICE CALL PROCESSOR * * * * * ************************** * * * SVCSCN RES 0 PSW,R15 WRKSTK LCI 4 PSM,R2 WRKSTK LI,R0 0 STW,R0 SVCSWT LI,R13 513 LI,R0 PDPPAG SAS,R0 -9 STH,R0 R13 LI,R0 KYWCMP STB,R0 R13 BAL,R14 G:COUPLE GET PDP FROM COMPUTATION FILE BNEZ $ LI,R2 511 * SVCCHK RES 0 LB,R4 PDPPAG,R2 LI,R5 1 CS,R4 R5 CHECK FOR ACTIVE PROCESS BNE SVCBDR LI,R5 2 CS,R4 R5 ACTIVE... CHECK FOR BREAK BNE SVCREQ MTW,1 SVCSWT LI,R1 BA(MSGPRC) BAL,R15 WRTSEG LW,R0 R2 LI,R1 2 BAL,R15 WRTHEX LI,R1 BA(MSGPBR) BAL,R15 WRTSEG BAL,R15 WRTOUT * SVCREQ RES 0 LI,R5 4 CS,R4 R5 CHECK FOR SERVICE REQUEST BNE SVCKIL MTW,1 SVCSWT LI,R1 BA(MSGPRC) BAL,R15 WRTSEG LW,R0 R2 LI,R1 2 BAL,R15 WRTHEX LI,R1 BA(MSGREQ) BAL,R15 WRTSEG BAL,R15 WRTOUT * SVCKIL RES 0 LI,R5 8 CS,R4 R5 CHECK FOR KILL BNE SVCBDR MTW,1 SVCSWT LW,R13 R2 BAL,R14 G:KLPRC LI,R1 BA(MSGPRC) BAL,R15 WRTSEG LW,R0 R2 LI,R1 2 BAL,R15 WRTHEX LI,R1 BA(MSGKIL) BAL,R15 WRTSEG BAL,R15 WRTOUT * SVCBDR RES 0 BDR,R2 SVCCHK MTW,0 SVCSWT BEZ SVCXIT LW,R13 G:PRCNUM BAL,R14 G:ASSINP * SVCXIT RES 0 LCI 4 PLM,R2 WRKSTK PLW,R15 WRKSTK LW,R0 SVCSWT B *R15 * PAGE * * * * ****************** * * * * * EXIT PROCESSOR * * * * * ****************** * * * EXIT RES 0 BAL,R14 G:FINPRC * PAGE * * * * ******************* * * * * * FORTRAN LINKAGE * * * * * ******************* * * * FRTPUB OPEN_ KYWLIB,KYWLIB,0,FRTOPN+1,1 FRTOPN OPEN_ KYWRTD,KYWLIB,0,$+1,1 TEXT ' FORTLIB ' * * ENTRY POINT TO REPORT SUB-PROCESSOR ABORT LOCATIONS: * FRTENT RES 0 MTW,R1 FRTSWT STW,R13 FRTABR STW,R12 FRTABR+1 B *R14 * * ENTRY POINT TO EXIT WITH COMMAND: * FRTMSG RES 0 LI,R0 1 STW,R0 MSGSWT SET EXIT WITH COMMAND SWITCH LB,R0 R13 STW,R0 SCNCNT LD,R2 SCNMV1 STW,R13 R2 MBS,R2 0 FILL INTERNAL MESSAGE BUFFER * * ENTRY POINT FOR PROGRAM EXIT: * FRTEXT RES 0 BAL,R15 BRKCHK RESET ALL BREAK-POINT CONTENTSK LI,R1 BA(MSGEXT) B ERRXIT * * ENTRY POINT TO LOAD FORTLIB: * FRTLIB RES 0 STCF USRPSW SAVE CONDITION CODE FOR GF:PIN LCI 0 STM,R0 USRREG SAVE REGISTERS LI,R0 FCB:USED STW,R0 FCBTYPE+2 ASSIGN KEYWORD 2 TO LIBRARY LI,R5 KYWLIB (5) <== KEYWORD FOR LIBRARY LW,R13 FRTOPN BAL,R14 G:OPEN OPEN UP FORTRAN LIBRARY BEZ LIBRARY GO AHEAD AND LOAD LIBRARY LW,R13 UTLPUB LI,R0 KYWLIB SLS,R0 24 AW,R13 R0 SET KEYWORD FOR LIBRARY BAL,R14 G:OPEN OPEN UP PUBLIC BNEZ FRTLB1 LW,R13 FRTPUB BAL,R14 G:OPEN TRY AGAIN FOR LIBRARY BEZ LIBRARY * FRTLB1 RES 0 LI,R1 BA(MSGLIB) B ERRXIT CANNOT OPEN NAMED FILE * RES SCRPG1+X'11FC'-$-X'200' * B FRTLIB INITIALIZE LIBRARY B FRTMSG EXIT WITH COMMAND (COUNT,ADDRESS) IN 13 B FRTEXT EXIT B FRTENT RESET USER ABORT AND INTERRUPT LOCAT IONS * PAGE * * HIGH LIMIT FOR DUMP * HICORE EQU $$ * * DUMP SHOULD BE: * * D(MASTER)200,HICORE * * END BTSBGN